Theory More_Transcendental
section ‹Introduction›
text ‹The complex plane or some of its parts (e.g., the unit disc or the upper half plane) are often
taken as the domain in which models of various geometries (both Euclidean and non-Euclidean ones)
are formalized. The complex plane gives simpler and more compact formulas than the Cartesian plane.
Within complex plane is easier to describe geometric objects and perform the calculations (usually
shedding some new light on the subject). We give a formalization of the extended complex
plane (given both as a complex projective space and as the Riemann sphere), its objects (points,
circles and lines), and its transformations (Möbius transformations).›
section ‹Related work›
text‹During the last decade, there have been many results in formalizing
geometry in proof-assistants. Parts of Hilbert’s seminal book
,,Foundations of Geometry'' \cite{hilbert} have been formalized both
in Coq and Isabelle/Isar. Formalization of first two groups of axioms
in Coq, in an intuitionistic setting was done by Dehlinger et
al. \cite{hilbert-coq}. First formalization in Isabelle/HOL was done
by Fleuriot and Meikele \cite{hilbert-isabelle}, and some further
developments were made in master thesis of Scott \cite{hilbert-scott}.
Large fragments of Tarski's geometry \cite{tarski} have been
formalized in Coq by Narboux et al. \cite{narboux-tarski}. Within Coq,
there are also formalizations of von Plato’s constructive geometry by
Kahn \cite{vonPlato,von-plato-formalization}, French high school
geometry by Guilhot \cite{guilhot} and ruler and compass geometry by
Duprat \cite{duprat2008}, etc.
In our previous work \cite{petrovic2012formalizing}, we have already
formally investigated a Cartesian model of Euclidean geometry.
›
section ‹Background theories›
text ‹In this section we introduce some basic mathematical notions and prove some lemmas needed in the rest of our
formalization. We describe:
▪ trigonometric functions,
▪ complex numbers,
▪ systems of two and three linear equations with two unknowns (over arbitrary fields),
▪ quadratic equations (over real and complex numbers), systems of quadratic and real
equations, and systems of two quadratic equations,
▪ two-dimensional vectors and matrices over complex numbers.
›
subsection ‹Library Additions for Trigonometric Functions›
theory More_Transcendental
imports Complex_Main "HOL-Library.Periodic_Fun"
begin
text ‹Additional properties of @{term sin} and @{term cos} functions that are later used in proving
conjectures for argument of complex number.›
text ‹Sign of trigonometric functions on some characteristic intervals.›
lemma cos_lt_zero_on_pi2_pi [simp]:
assumes "x > pi/2" and "x ≤ pi"
shows "cos x < 0"
using cos_gt_zero_pi[of "pi - x"] assms
by simp
text ‹Value of trigonometric functions in points $k\pi$ and $\frac{\pi}{2} + k\pi$.›
lemma sin_kpi [simp]:
fixes k::int
shows "sin (k * pi) = 0"
by (simp add: sin_zero_iff_int2)
lemma cos_odd_kpi [simp]:
fixes k::int
assumes "odd k"
shows "cos (k * pi) = -1"
by (simp add: assms mult.commute)
lemma cos_even_kpi [simp]:
fixes k::int
assumes "even k"
shows "cos (k * pi) = 1"
by (simp add: assms mult.commute)
lemma sin_pi2_plus_odd_kpi [simp]:
fixes k::int
assumes "odd k"
shows "sin (pi / 2 + k * pi) = -1"
using assms
by (simp add: sin_add)
lemma sin_pi2_plus_even_kpi [simp]:
fixes k::int
assumes "even k"
shows "sin (pi / 2 + k * pi) = 1"
using assms
by (simp add: sin_add)
text ‹Solving trigonometric equations and systems with special values (0, 1, or -1) of sine and cosine functions›
lemma cos_0_iff_canon:
assumes "cos φ = 0" and "-pi < φ" and "φ ≤ pi"
shows "φ = pi/2 ∨ φ = -pi/2"
by (smt (verit, best) arccos_0 arccos_cos assms cos_minus divide_minus_left)
lemma sin_0_iff_canon:
assumes "sin φ = 0" and "-pi < φ" and "φ ≤ pi"
shows "φ = 0 ∨ φ = pi"
using assms sin_eq_0_pi by force
lemma cos0_sin1:
assumes "sin φ = 1"
shows "∃ k::int. φ = pi/2 + 2*k*pi"
by (smt (verit, ccfv_threshold) assms cos_diff cos_one_2pi_int cos_pi_half mult_cancel_right1 sin_pi_half sin_plus_pi)
text ‹Sine is injective on $[-\frac{\pi}{2}, \frac{\pi}{2}]$›
lemma sin_inj:
assumes "-pi/2 ≤ α ∧ α ≤ pi/2" and "-pi/2 ≤ α' ∧ α' ≤ pi/2"
assumes "α ≠ α'"
shows "sin α ≠ sin α'"
by (metis assms divide_minus_left sin_inj_pi)
text ‹Periodicity of trigonometric functions›
text ‹The following are available in HOL-Decision\_Procs.Approximation\_Bounds, but we want to avoid
that dependency›
lemma sin_periodic_nat [simp]:
fixes n :: nat
shows "sin (x + n * (2 * pi)) = sin x"
by (metis (no_types, hide_lams) add.commute add.left_neutral cos_2npi cos_one_2pi_int mult.assoc mult.commute mult.left_neutral mult_zero_left sin_add sin_int_2pin)
lemma sin_periodic_int [simp]:
fixes i :: int
shows "sin (x + i * (2 * pi)) = sin x"
by (metis add.right_neutral cos_int_2pin mult.commute mult.right_neutral mult_zero_right sin_add sin_int_2pin)
lemma cos_periodic_nat [simp]:
fixes n :: nat
shows "cos (x + n * (2 * pi)) = cos x"
by (metis add.left_neutral cos_2npi cos_add cos_periodic mult.assoc mult_2 mult_2_right of_nat_numeral sin_periodic sin_periodic_nat)
lemma cos_periodic_int [simp]:
fixes i :: int
shows "cos (x + i * (2 * pi)) = cos x"
by (metis cos_add cos_int_2pin diff_zero mult.commute mult.right_neutral mult_zero_right sin_int_2pin)
text ‹Values of both sine and cosine are repeated only after multiples of $2\cdot \pi$›
lemma sin_cos_eq:
fixes a b :: real
assumes "cos a = cos b" and "sin a = sin b"
shows "∃ k::int. a - b = 2*k*pi"
by (metis assms cos_diff cos_one_2pi_int mult.commute sin_cos_squared_add3)
text ‹The following two lemmas are consequences of surjectivity of cosine for the range $[-1, 1]$.›
lemma ex_cos_eq:
assumes "-pi/2 ≤ α ∧ α ≤ pi/2"
assumes "a ≥ 0" and "a < 1"
shows "∃ α'. -pi/2 ≤ α' ∧ α' ≤ pi/2 ∧ α' ≠ α ∧ cos (α - α') = a"
proof-
have "arccos a > 0" "arccos a ≤ pi/2"
using ‹a ≥ 0› ‹a < 1›
using arccos_lt_bounded arccos_le_pi2
by auto
show ?thesis
proof (cases "α - arccos a ≥ - pi/2")
case True
thus ?thesis
using assms ‹arccos a > 0› ‹arccos a ≤ pi/2›
by (rule_tac x = "α - arccos a" in exI) auto
next
case False
thus ?thesis
using assms ‹arccos a > 0› ‹arccos a ≤ pi/2›
by (rule_tac x = "α + arccos a" in exI) auto
qed
qed
lemma ex_cos_gt:
assumes "-pi/2 ≤ α ∧ α ≤ pi/2"
assumes "a < 1"
shows "∃ α'. -pi/2 ≤ α' ∧ α' ≤ pi/2 ∧ α' ≠ α ∧ cos (α - α') > a"
proof-
obtain a' where "a' ≥ 0" "a' > a" "a' < 1"
by (metis assms(2) dense_le_bounded linear not_one_le_zero)
thus ?thesis
using ex_cos_eq[of α a'] assms
by auto
qed
text ‹The function @{term atan2} is a generalization of @{term arctan} that takes a pair of coordinates
of non-zero points returns its angle in the range $[-\pi, \pi)$.›
definition atan2 where
"atan2 y x =
(if x > 0 then arctan (y/x)
else if x < 0 then
if y > 0 then arctan (y/x) + pi else arctan (y/x) - pi
else
if y > 0 then pi/2 else if y < 0 then -pi/2 else 0)"
lemma atan2_bounded:
shows "-pi ≤ atan2 y x ∧ atan2 y x < pi"
using arctan_bounded[of "y/x"] zero_le_arctan_iff[of "y/x"] arctan_le_zero_iff[of "y/x"] zero_less_arctan_iff[of "y/x"] arctan_less_zero_iff[of "y/x"]
using divide_neg_neg[of y x] divide_neg_pos[of y x] divide_pos_pos[of y x] divide_pos_neg[of y x]
unfolding atan2_def
by (simp (no_asm_simp)) auto
end
Theory Canonical_Angle
subsection ‹Canonical angle›
text ‹Canonize any angle to $(-\pi, \pi]$ (taking account of $2\pi$ periodicity of @{term sin} and
@{term cos}). With this function, for example, multiplicative properties of @{term arg} for complex
numbers can easily be expressed and proved.›
theory Canonical_Angle
imports More_Transcendental
begin
abbreviation canon_ang_P where
"canon_ang_P α α' ≡ (-pi < α' ∧ α' ≤ pi) ∧ (∃ k::int. α - α' = 2*k*pi)"
definition canon_ang :: "real ⇒ real" ("⇂_⇃") where
"⇂α⇃ = (THE α'. canon_ang_P α α')"
text ‹There is a canonical angle for every angle.›
lemma canon_ang_ex:
shows "∃ α'. canon_ang_P α α'"
proof-
have ***: "∀ α::real. ∃ α'. 0 < α' ∧ α' ≤ 1 ∧ (∃ k::int. α' = α - k)"
proof
fix α::real
show "∃α'>0. α' ≤ 1 ∧ (∃k::int. α' = α - k)"
proof (cases "α = floor α")
case True
thus ?thesis
by (rule_tac x="α - floor α + 1" in exI, auto) (rule_tac x="floor α - 1" in exI, auto)
next
case False
thus ?thesis
using real_of_int_floor_ge_diff_one[of "α"]
using of_int_floor_le[of "α"]
by (rule_tac x="α - floor α" in exI) smt
qed
qed
have **: "∀ α::real. ∃ α'. 0 < α' ∧ α' ≤ 2 ∧ (∃ k::int. α - α' = 2*k - 1)"
proof
fix α::real
from ***[rule_format, of "(α + 1) /2"]
obtain α' and k::int where "0 < α'" "α' ≤ 1" "α' = (α + 1)/2 - k"
by force
hence "0 < α'" "α' ≤ 1" "α' = α/2 - k + 1/2"
by auto
thus "∃α'>0. α' ≤ 2 ∧ (∃k::int. α - α' = real_of_int (2 * k - 1))"
by (rule_tac x="2*α'" in exI) auto
qed
have *: "∀ α::real. ∃ α'. -1 < α' ∧ α' ≤ 1 ∧ (∃ k::int. α - α' = 2*k)"
proof
fix α::real
from ** obtain α' and k :: int where
"0 < α' ∧ α' ≤ 2 ∧ α - α' = 2*k - 1"
by force
thus "∃α'>-1. α' ≤ 1 ∧ (∃k. α - α' = real_of_int (2 * (k::int)))"
by (rule_tac x="α' - 1" in exI) (auto simp add: field_simps)
qed
obtain α' k where 1: "α' >- 1 ∧ α' ≤ 1" and 2: "α / pi - α' = real_of_int (2 * k)"
using *[rule_format, of "α / pi"]
by auto
have "α'*pi > -pi ∧ α'*pi ≤ pi"
using 1
by (smt mult.commute mult_le_cancel_left1 mult_minus_right pi_gt_zero)
moreover
have "α - α'*pi = 2 * real_of_int k * pi"
using 2
by (auto simp add: field_simps)
ultimately
show ?thesis
by auto
qed
text ‹Canonical angle of any angle is unique.›
lemma canon_ang_unique:
assumes "canon_ang_P α α⇩1" and "canon_ang_P α α⇩2"
shows "α⇩1 = α⇩2"
proof-
obtain k1::int where "α - α⇩1 = 2*k1*pi"
using assms(1)
by auto
obtain k2::int where "α - α⇩2 = 2*k2*pi"
using assms(2)
by auto
hence *: "-α⇩1 + α⇩2 = 2*(k1 - k2)*pi"
using ‹α - α⇩1 = 2*k1*pi›
by (simp add:field_simps)
moreover
have "-α⇩1 + α⇩2 < 2 * pi" "-α⇩1 + α⇩2 > -2*pi"
using assms
by auto
ultimately
have "-α⇩1 + α⇩2 = 0"
using mult_less_cancel_right[of "-2" pi "real_of_int(2 * (k1 - k2))"]
by auto
thus ?thesis
by auto
qed
text ‹Canonical angle is always in $(-\pi, \pi]$ and differs from the starting angle by $2k\pi$.›
lemma canon_ang:
shows "-pi < ⇂α⇃" and "⇂α⇃ ≤ pi" and "∃ k::int. α - ⇂α⇃ = 2*k*pi"
proof-
obtain α' where "canon_ang_P α α'"
using canon_ang_ex[of α]
by auto
have "canon_ang_P α ⇂α⇃"
unfolding canon_ang_def
proof (rule theI[where a="α'"])
show "canon_ang_P α α'"
by fact
next
fix α''
assume "canon_ang_P α α''"
thus "α'' = α'"
using ‹canon_ang_P α α'›
using canon_ang_unique[of α' α α'']
by simp
qed
thus "-pi < ⇂α⇃" "⇂α⇃ ≤ pi" "∃ k::int. α - ⇂α⇃ = 2*k*pi"
by auto
qed
text ‹Angles in $(-\pi, \pi]$ are already canonical.›
lemma canon_ang_id:
assumes "-pi < α ∧ α ≤ pi"
shows "⇂α⇃ = α"
using assms
using canon_ang_unique[of "canon_ang α" α α] canon_ang[of α]
by auto
text ‹Angles that differ by $2k\pi$ have equal canonical angles.›
lemma canon_ang_eq:
assumes "∃ k::int. α⇩1 - α⇩2 = 2*k*pi"
shows "⇂α⇩1⇃ = ⇂α⇩2⇃"
proof-
obtain k'::int where *: "- pi < ⇂α⇩1⇃" "⇂α⇩1⇃ ≤ pi" "α⇩1 - ⇂α⇩1⇃ = 2 * k' * pi"
using canon_ang[of α⇩1]
by auto
obtain k''::int where **: "- pi < ⇂α⇩2⇃" "⇂α⇩2⇃ ≤ pi" "α⇩2 - ⇂α⇩2⇃ = 2 * k'' * pi"
using canon_ang[of α⇩2]
by auto
obtain k::int where ***: "α⇩1 - α⇩2 = 2*k*pi"
using assms
by auto
have "∃m::int. α⇩1 - ⇂α⇩2⇃ = 2 * m * pi"
using **(3) ***
by (rule_tac x="k+k''" in exI) (auto simp add: field_simps)
thus ?thesis
using canon_ang_unique[of "⇂α⇩1⇃" α⇩1 "⇂α⇩2⇃"] * **
by auto
qed
text ‹Introduction and elimination rules›
lemma canon_ang_eqI:
assumes "∃k::int. α' - α = 2 * k * pi" and "- pi < α' ∧ α' ≤ pi"
shows "⇂α⇃ = α'"
using assms
using canon_ang_eq[of α' α]
using canon_ang_id[of α']
by auto
lemma canon_ang_eqE:
assumes "⇂α⇩1⇃ = ⇂α⇩2⇃"
shows "∃ (k::int). α⇩1 - α⇩2 = 2 *k * pi"
proof-
obtain k1 k2 :: int where
"α⇩1 - ⇂α⇩1⇃ = 2 * k1 * pi"
"α⇩2 - ⇂α⇩2⇃ = 2 * k2 * pi"
using canon_ang[of α⇩1] canon_ang[of α⇩2]
by auto
thus ?thesis
using assms
by (rule_tac x="k1 - k2" in exI) (auto simp add: field_simps)
qed
text ‹Canonical angle of opposite angle›
lemma canon_ang_uminus:
assumes "⇂α⇃ ≠ pi"
shows "⇂-α⇃ = -⇂α⇃"
proof (rule canon_ang_eqI)
show "∃x::int. - ⇂α⇃ - - α = 2 * x * pi"
using canon_ang(3)[of α]
by (metis minus_diff_eq minus_diff_minus)
next
show "- pi < - ⇂α⇃ ∧ - ⇂α⇃ ≤ pi"
using canon_ang(1)[of α] canon_ang(2)[of α] assms
by auto
qed
lemma canon_ang_uminus_pi:
assumes "⇂α⇃ = pi"
shows "⇂-α⇃ = ⇂α⇃"
proof (rule canon_ang_eqI)
obtain k::int where "α - ⇂α⇃ = 2 * k * pi"
using canon_ang(3)[of α]
by auto
thus "∃x::int. ⇂α⇃ - - α = 2 * x * pi"
using assms
by (rule_tac x="k+(1::int)" in exI) (auto simp add: field_simps)
next
show "- pi < ⇂α⇃ ∧ ⇂α⇃ ≤ pi"
using assms
by auto
qed
text ‹Canonical angle of difference of two angles›
lemma canon_ang_diff:
shows "⇂α - β⇃ = ⇂⇂α⇃ - ⇂β⇃⇃"
proof (rule canon_ang_eq)
show "∃x::int. α - β - (⇂α⇃ - ⇂β⇃) = 2 * x * pi"
proof-
obtain k1::int where "α - ⇂α⇃ = 2*k1*pi"
using canon_ang(3)
by auto
moreover
obtain k2::int where "β - ⇂β⇃ = 2*k2*pi"
using canon_ang(3)
by auto
ultimately
show ?thesis
by (rule_tac x="k1 - k2" in exI) (auto simp add: field_simps)
qed
qed
text ‹Canonical angle of sum of two angles›
lemma canon_ang_sum:
shows "⇂α + β⇃ = ⇂⇂α⇃ + ⇂β⇃⇃"
proof (rule canon_ang_eq)
show "∃x::int. α + β - (⇂α⇃ + ⇂β⇃) = 2 * x * pi"
proof-
obtain k1::int where "α - ⇂α⇃ = 2*k1*pi"
using canon_ang(3)
by auto
moreover
obtain k2::int where "β - ⇂β⇃ = 2*k2*pi"
using canon_ang(3)
by auto
ultimately
show ?thesis
by (rule_tac x="k1 + k2" in exI) (auto simp add: field_simps)
qed
qed
text ‹Canonical angle of angle from $(0, 2\pi]$ shifted by $\pi$›
lemma canon_ang_plus_pi1:
assumes "0 < α" and "α ≤ 2*pi"
shows "⇂α + pi⇃ = α - pi"
proof (rule canon_ang_eqI)
show "∃ x::int. α - pi - (α + pi) = 2 * x * pi"
by (rule_tac x="-1" in exI) auto
next
show "- pi < α - pi ∧ α - pi ≤ pi"
using assms
by auto
qed
lemma canon_ang_minus_pi1:
assumes "0 < α" and "α ≤ 2*pi"
shows "⇂α - pi⇃ = α - pi"
proof (rule canon_ang_id)
show "- pi < α - pi ∧ α - pi ≤ pi"
using assms
by auto
qed
text ‹Canonical angle of angles from $(-2\pi, 0]$ shifted by $\pi$›
lemma canon_ang_plus_pi2:
assumes "-2*pi < α" and "α ≤ 0"
shows "⇂α + pi⇃ = α + pi"
proof (rule canon_ang_id)
show "- pi < α + pi ∧ α + pi ≤ pi"
using assms
by auto
qed
lemma canon_ang_minus_pi2:
assumes "-2*pi < α" and "α ≤ 0"
shows "⇂α - pi⇃ = α + pi"
proof (rule canon_ang_eqI)
show "∃ x::int. α + pi - (α - pi) = 2 * x * pi"
by (rule_tac x="1" in exI) auto
next
show "- pi < α + pi ∧ α + pi ≤ pi"
using assms
by auto
qed
text ‹Canonical angle of angle in $(\pi, 3\pi]$.›
lemma canon_ang_pi_3pi:
assumes "pi < α" and "α ≤ 3 * pi"
shows "⇂α⇃ = α - 2*pi"
proof-
have "∃x. - pi = pi * real_of_int x"
by (rule_tac x="-1" in exI, simp)
thus ?thesis
using assms canon_ang_eqI[of "α - 2*pi" "α"]
by auto
qed
text ‹Canonical angle of angle in $(-3\pi, -\pi]$.›
lemma canon_ang_minus_3pi_minus_pi:
assumes "-3*pi < α" and "α ≤ -pi"
shows "⇂α⇃ = α + 2*pi"
proof-
have "∃x. pi = pi * real_of_int x"
by (rule_tac x="1" in exI, simp)
thus ?thesis
using assms canon_ang_eqI[of "α + 2*pi" "α"]
by auto
qed
text ‹Canonical angles for some special angles›
lemma zero_canonical [simp]:
shows "⇂0⇃ = 0"
using canon_ang_eqI[of 0 0]
by simp
lemma pi_canonical [simp]:
shows "⇂pi⇃ = pi"
by (simp add: canon_ang_id)
lemma two_pi_canonical [simp]:
shows "⇂2 * pi⇃ = 0"
using canon_ang_plus_pi1[of "pi"]
by simp
text ‹Canonization preserves sine and cosine›
lemma canon_ang_sin [simp]:
shows "sin ⇂α⇃ = sin α"
proof-
obtain x::int where "α = ⇂α⇃ + pi * (x * 2)"
using canon_ang(3)[of α]
by (auto simp add: field_simps)
thus ?thesis
using sin_periodic_int[of "⇂α⇃" x]
by (simp add: field_simps)
qed
lemma canon_ang_cos [simp]:
shows "cos ⇂α⇃ = cos α"
proof-
obtain x::int where "α = ⇂α⇃ + pi * (x * 2)"
using canon_ang(3)[of α]
by (auto simp add: field_simps)
thus ?thesis
using cos_periodic_int[of "⇂α⇃" x]
by (simp add: field_simps)
qed
end
Theory More_Complex
subsection ‹Library Additions for Complex Numbers›
text ‹Some additional lemmas about complex numbers.›
theory More_Complex
imports Complex_Main More_Transcendental Canonical_Angle
begin
text ‹Conjugation and @{term cis}›
declare cis_cnj[simp]
lemma rcis_cnj:
shows "cnj a = rcis (cmod a) (- arg a)"
by (subst rcis_cmod_arg[of a, symmetric]) (simp add: rcis_def)
lemmas complex_cnj = complex_cnj_diff complex_cnj_mult complex_cnj_add complex_cnj_divide complex_cnj_minus
text ‹Some properties for @{term complex_of_real}. Also, since it is often used in our
formalization we abbreviate it to @{term cor}.›
abbreviation cor :: "real ⇒ complex" where
"cor ≡ complex_of_real"
lemma cmod_cis [simp]:
assumes "a ≠ 0"
shows "cor (cmod a) * cis (arg a) = a"
using assms
by (metis rcis_cmod_arg rcis_def)
lemma cis_cmod [simp]:
assumes "a ≠ 0"
shows "cis (arg a) * cor (cmod a) = a"
using assms cmod_cis[of a]
by (simp add: field_simps)
lemma cor_squared:
shows "(cor x)⇧2 = cor (x⇧2)"
by (simp add: power2_eq_square)
lemma cor_sqrt_mult_cor_sqrt [simp]:
shows "cor (sqrt A) * cor (sqrt A) = cor ¦A¦"
by (metis of_real_mult real_sqrt_mult_self)
lemma cor_eq_0: "cor x + 𝗂 * cor y = 0 ⟷ x = 0 ∧ y = 0"
by (metis Complex_eq Im_complex_of_real Im_i_times Re_complex_of_real add_cancel_left_left of_real_eq_0_iff plus_complex.sel(2) zero_complex.code)
lemma one_plus_square_neq_zero [simp]:
shows "1 + (cor x)⇧2 ≠ 0"
by (metis (hide_lams, no_types) of_real_1 of_real_add of_real_eq_0_iff of_real_power power_one sum_power2_eq_zero_iff zero_neq_one)
text ‹Additional lemmas about @{term Complex} constructor. Following newer versions of Isabelle,
these should be deprecated.›
lemma complex_real_two [simp]:
shows "Complex 2 0 = 2"
by (simp add: Complex_eq)
lemma complex_double [simp]:
shows "(Complex a b) * 2 = Complex (2*a) (2*b)"
by (simp add: Complex_eq)
lemma complex_half [simp]:
shows "(Complex a b) / 2 = Complex (a/2) (b/2)"
by (subst complex_eq_iff) auto
lemma Complex_scale1:
shows "Complex (a * b) (a * c) = cor a * Complex b c"
unfolding complex_of_real_def
unfolding Complex_eq
by (auto simp add: field_simps)
lemma Complex_scale2:
shows "Complex (a * c) (b * c) = Complex a b * cor c"
unfolding complex_of_real_def
unfolding Complex_eq
by (auto simp add: field_simps)
lemma Complex_scale3:
shows "Complex (a / b) (a / c) = cor a * Complex (1 / b) (1 / c)"
unfolding complex_of_real_def
unfolding Complex_eq
by (auto simp add: field_simps)
lemma Complex_scale4:
shows "c ≠ 0 ⟹ Complex (a / c) (b / c) = Complex a b / cor c"
unfolding complex_of_real_def
unfolding Complex_eq
by (auto simp add: field_simps power2_eq_square)
lemma Complex_Re_express_cnj:
shows "Complex (Re z) 0 = (z + cnj z) / 2"
by (cases z) (simp add: Complex_eq)
lemma Complex_Im_express_cnj:
shows "Complex 0 (Im z) = (z - cnj z)/2"
by (cases z) (simp add: Complex_eq)
text ‹Additional properties of @{term cmod}.›
lemma complex_mult_cnj_cmod:
shows "z * cnj z = cor ((cmod z)⇧2)"
using complex_norm_square
by auto
lemma cmod_square:
shows "(cmod z)⇧2 = Re (z * cnj z)"
using complex_mult_cnj_cmod[of z]
by (simp add: power2_eq_square)
lemma cor_cmod_power_4 [simp]:
shows "cor (cmod z) ^ 4 = (z * cnj z)⇧2"
by (simp add: complex_mult_cnj_cmod)
lemma cnjE:
assumes "x ≠ 0"
shows "cnj x = cor ((cmod x)⇧2) / x"
using complex_mult_cnj_cmod[of x] assms
by (auto simp add: field_simps)
lemma cmod_cor_divide [simp]:
shows "cmod (z / cor k) = cmod z / ¦k¦"
by (simp add: norm_divide)
lemma cmod_mult_minus_left_distrib [simp]:
shows "cmod (z*z1 - z*z2) = cmod z * cmod(z1 - z2)"
by (metis norm_mult right_diff_distrib)
lemma cmod_eqI:
assumes "z1 * cnj z1 = z2 * cnj z2"
shows "cmod z1 = cmod z2"
using assms
by (subst complex_mod_sqrt_Re_mult_cnj)+ auto
lemma cmod_eqE:
assumes "cmod z1 = cmod z2"
shows "z1 * cnj z1 = z2 * cnj z2"
by (simp add: assms complex_mult_cnj_cmod)
lemma cmod_eq_one [simp]:
shows "cmod a = 1 ⟷ a*cnj a = 1"
by (metis cmod_eqE cmod_eqI complex_cnj_one monoid_mult_class.mult.left_neutral norm_one)
text ‹We introduce @{term is_real} (the imaginary part of complex number is zero) and @{term is_imag}
(real part of complex number is zero) operators and prove some of their properties.›
abbreviation is_real where
"is_real z ≡ Im z = 0"
abbreviation is_imag where
"is_imag z ≡ Re z = 0"
lemma real_imag_0:
assumes "is_real a" "is_imag a"
shows "a = 0"
using assms
by (simp add: complex.expand)
lemma complex_eq_if_Re_eq:
assumes "is_real z1" and "is_real z2"
shows "z1 = z2 ⟷ Re z1 = Re z2"
using assms
by (cases z1, cases z2) auto
lemma mult_reals [simp]:
assumes "is_real a" and "is_real b"
shows "is_real (a * b)"
using assms
by auto
lemma div_reals [simp]:
assumes "is_real a" and "is_real b"
shows "is_real (a / b)"
using assms
by (simp add: complex_is_Real_iff)
lemma complex_of_real_Re [simp]:
assumes "is_real k"
shows "cor (Re k) = k"
using assms
by (cases k) (auto simp add: complex_of_real_def)
lemma cor_cmod_real:
assumes "is_real a"
shows "cor (cmod a) = a ∨ cor (cmod a) = -a"
using assms
unfolding cmod_def
by (cases "Re a > 0") auto
lemma eq_cnj_iff_real:
shows "cnj z = z ⟷ is_real z"
by (cases z) (simp add: Complex_eq)
lemma eq_minus_cnj_iff_imag:
shows "cnj z = -z ⟷ is_imag z"
by (cases z) (simp add: Complex_eq)
lemma Re_divide_real:
assumes "is_real b" and "b ≠ 0"
shows "Re (a / b) = (Re a) / (Re b)"
using assms
by (simp add: complex_is_Real_iff)
lemma Re_mult_real:
assumes "is_real a"
shows "Re (a * b) = (Re a) * (Re b)"
using assms
by simp
lemma Im_mult_real:
assumes "is_real a"
shows "Im (a * b) = (Re a) * (Im b)"
using assms
by simp
lemma Im_divide_real:
assumes "is_real b" and "b ≠ 0"
shows "Im (a / b) = (Im a) / (Re b)"
using assms
by (simp add: complex_is_Real_iff)
lemma Re_sgn:
assumes "is_real R"
shows "Re (sgn R) = sgn (Re R)"
using assms
by (metis Re_sgn complex_of_real_Re norm_of_real real_sgn_eq)
lemma is_real_div:
assumes "b ≠ 0"
shows "is_real (a / b) ⟷ a*cnj b = b*cnj a"
using assms
by (metis complex_cnj_divide complex_cnj_zero_iff eq_cnj_iff_real frac_eq_eq mult.commute)
lemma is_real_mult_real:
assumes "is_real a" and "a ≠ 0"
shows "is_real b ⟷ is_real (a * b)"
using assms
by (cases a, auto simp add: Complex_eq)
lemma Im_express_cnj:
shows "Im z = (z - cnj z) / (2 * 𝗂)"
by (simp add: complex_diff_cnj field_simps)
lemma Re_express_cnj:
shows "Re z = (z + cnj z) / 2"
by (simp add: complex_add_cnj)
text ‹Rotation of complex number for 90 degrees in the positive direction.›
abbreviation rot90 where
"rot90 z ≡ Complex (-Im z) (Re z)"
lemma rot90_ii:
shows "rot90 z = z * 𝗂"
by (metis Complex_mult_i complex_surj)
text ‹With @{term cnj_mix} we introduce scalar product between complex vectors. This operation shows
to be useful to succinctly express some conditions.›
abbreviation cnj_mix where
"cnj_mix z1 z2 ≡ cnj z1 * z2 + z1 * cnj z2"
abbreviation scalprod where
"scalprod z1 z2 ≡ cnj_mix z1 z2 / 2"
lemma cnj_mix_minus:
shows "cnj z1*z2 - z1*cnj z2 = 𝗂 * cnj_mix (rot90 z1) z2"
by (cases z1, cases z2) (simp add: Complex_eq field_simps)
lemma cnj_mix_minus':
shows "cnj z1*z2 - z1*cnj z2 = rot90 (cnj_mix (rot90 z1) z2)"
by (cases z1, cases z2) (simp add: Complex_eq field_simps)
lemma cnj_mix_real [simp]:
shows "is_real (cnj_mix z1 z2)"
by (cases z1, cases z2) simp
lemma scalprod_real [simp]:
shows "is_real (scalprod z1 z2)"
using cnj_mix_real
by simp
text ‹Additional properties of @{term cis} function.›
lemma cis_minus_pi2 [simp]:
shows "cis (-pi/2) = -𝗂"
by (simp add: cis_inverse[symmetric])
lemma cis_pi2_minus_x [simp]:
shows "cis (pi/2 - x) = 𝗂 * cis(-x)"
using cis_divide[of "pi/2" x, symmetric]
using cis_divide[of 0 x, symmetric]
by simp
lemma cis_pm_pi [simp]:
shows "cis (x - pi) = - cis x" and "cis (x + pi) = - cis x"
by (simp add: cis.ctr complex_minus)+
lemma cis_times_cis_opposite [simp]:
shows "cis φ * cis (- φ) = 1"
by (simp add: cis_mult)
text ‹@{term cis} repeats only after $2k\pi$›
lemma cis_eq:
assumes "cis a = cis b"
shows "∃ k::int. a - b = 2 * k * pi"
using assms sin_cos_eq[of a b]
using cis.sel[of a] cis.sel[of b]
by (cases "cis a", cases "cis b") auto
text ‹@{term cis} is injective on $(-\pi, \pi]$.›
lemma cis_inj:
assumes "-pi < α" and "α ≤ pi" and "-pi < α'" and "α' ≤ pi"
assumes "cis α = cis α'"
shows "α = α'"
using assms
by (metis arg_unique sgn_cis)
text ‹@{term cis} of an angle combined with @{term cis} of the opposite angle›
lemma cis_diff_cis_opposite [simp]:
shows "cis φ - cis (- φ) = 2 * 𝗂 * sin φ"
using Im_express_cnj[of "cis φ"]
by simp
lemma cis_opposite_diff_cis [simp]:
shows "cis (-φ) - cis (φ) = - 2 * 𝗂 * sin φ"
using cis_diff_cis_opposite[of "-φ"]
by simp
lemma cis_add_cis_opposite [simp]:
shows "cis φ + cis (-φ) = 2 * cos φ"
by (metis cis.sel(1) cis_cnj complex_add_cnj)
text ‹@{term cis} equal to 1 or -1›
lemma cis_one [simp]:
assumes "sin φ = 0" and "cos φ = 1"
shows "cis φ = 1"
using assms
by (auto simp add: cis.ctr one_complex.code)
lemma cis_minus_one [simp]:
assumes "sin φ = 0" and "cos φ = -1"
shows "cis φ = -1"
using assms
by (auto simp add: cis.ctr Complex_eq_neg_1)
subsubsection ‹Additional properties of complex number argument›
text ‹@{term arg} of real numbers›
lemma is_real_arg1:
assumes "arg z = 0 ∨ arg z = pi"
shows "is_real z"
using assms
using rcis_cmod_arg[of z] Im_rcis[of "cmod z" "arg z"]
by auto
lemma is_real_arg2:
assumes "is_real z"
shows "arg z = 0 ∨ arg z = pi"
proof (cases "z = 0")
case False
thus ?thesis
using arg_bounded[of z]
by (smt (verit, best) Im_sgn assms cis.simps(2) cis_arg div_0 sin_zero_pi_iff)
qed (auto simp add: arg_zero)
lemma arg_complex_of_real_positive [simp]:
assumes "k > 0"
shows "arg (cor k) = 0"
proof-
have "cos (arg (Complex k 0)) > 0"
using assms
using rcis_cmod_arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "arg (Complex k 0)"]
using cmod_eq_Re by force
thus ?thesis
using assms is_real_arg2[of "cor k"]
unfolding complex_of_real_def
by auto
qed
lemma arg_complex_of_real_negative [simp]:
assumes "k < 0"
shows "arg (cor k) = pi"
proof-
have "cos (arg (Complex k 0)) < 0"
using ‹k < 0› rcis_cmod_arg[of "Complex k 0"] Re_rcis[of "cmod (Complex k 0)" "arg (Complex k 0)"]
by (metis complex.sel(1) mult_less_0_iff norm_not_less_zero)
thus ?thesis
using assms is_real_arg2[of "cor k"]
unfolding complex_of_real_def
by auto
qed
lemma arg_0_iff:
shows "z ≠ 0 ∧ arg z = 0 ⟷ is_real z ∧ Re z > 0"
by (smt arg_complex_of_real_negative arg_complex_of_real_positive arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps)
lemma arg_pi_iff:
shows "arg z = pi ⟷ is_real z ∧ Re z < 0"
by (smt arg_complex_of_real_negative arg_complex_of_real_positive arg_zero complex_of_real_Re is_real_arg1 pi_gt_zero zero_complex.simps)
text ‹@{term arg} of imaginary numbers›
lemma is_imag_arg1:
assumes "arg z = pi/2 ∨ arg z = -pi/2"
shows "is_imag z"
using assms
using rcis_cmod_arg[of z] Re_rcis[of "cmod z" "arg z"]
by (metis cos_minus cos_pi_half minus_divide_left mult_eq_0_iff)
lemma is_imag_arg2:
assumes "is_imag z" and "z ≠ 0"
shows "arg z = pi/2 ∨ arg z = -pi/2"
using arg_bounded assms cos_0_iff_canon cos_arg_i_mult_zero by presburger
lemma arg_complex_of_real_times_i_positive [simp]:
assumes "k > 0"
shows "arg (cor k * 𝗂) = pi / 2"
proof-
have "sin (arg (Complex 0 k)) > 0"
using ‹k > 0› rcis_cmod_arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "arg (Complex 0 k)"]
by (smt complex.sel(2) mult_nonneg_nonpos norm_ge_zero)
thus ?thesis
using assms is_imag_arg2[of "cor k * 𝗂"]
using arg_zero complex_of_real_i
by force
qed
lemma arg_complex_of_real_times_i_negative [simp]:
assumes "k < 0"
shows "arg (cor k * 𝗂) = - pi / 2"
proof-
have "sin (arg (Complex 0 k)) < 0"
using ‹k < 0› rcis_cmod_arg[of "Complex 0 k"] Im_rcis[of "cmod (Complex 0 k)" "arg (Complex 0 k)"]
by (metis complex.sel(2) mult_less_0_iff norm_not_less_zero)
thus ?thesis
using assms is_imag_arg2[of "cor k * 𝗂"]
using arg_zero complex_of_real_i[of k]
by (smt complex.sel(1) sin_pi_half sin_zero)
qed
lemma arg_pi2_iff:
shows "z ≠ 0 ∧ arg z = pi / 2 ⟷ is_imag z ∧ Im z > 0"
by (smt Im_rcis Re_i_times Re_rcis arcsin_minus_1 cos_pi_half divide_minus_left mult.commute mult_cancel_right1 rcis_cmod_arg is_imag_arg2 sin_arcsin sin_pi_half zero_less_mult_pos zero_less_norm_iff)
lemma arg_minus_pi2_iff:
shows "z ≠ 0 ∧ arg z = - pi / 2 ⟷ is_imag z ∧ Im z < 0"
by (smt arg_pi2_iff complex.expand divide_cancel_right pi_neq_zero is_imag_arg1 is_imag_arg2 zero_complex.simps(1) zero_complex.simps(2))
lemma arg_ii [simp]:
shows "arg 𝗂 = pi/2"
by (metis arg_pi2_iff imaginary_unit.sel zero_less_one)
lemma arg_minus_ii [simp]:
shows "arg (-𝗂) = -pi/2"
proof-
have "-𝗂 = cis (arg (- 𝗂))"
using rcis_cmod_arg[of "-𝗂"]
by (simp add: rcis_def)
hence "cos (arg (-𝗂)) = 0" "sin (arg (-𝗂)) = -1"
using cis.simps[of "arg (-𝗂)"]
by auto
thus ?thesis
using cos_0_iff_canon[of "arg (-𝗂)"] arg_bounded[of "-𝗂"]
by fastforce
qed
text ‹Argument is a canonical angle›
lemma canon_ang_arg:
shows "⇂arg z⇃ = arg z"
using canon_ang_id[of "arg z"] arg_bounded
by simp
lemma arg_cis:
shows "arg (cis φ) = ⇂φ⇃"
using arg_unique canon_ang canon_ang_cos canon_ang_sin cis.ctr sgn_cis by presburger
text ‹Cosine and sine of @{term arg}›
lemma cos_arg:
assumes "z ≠ 0"
shows "cos (arg z) = Re z / cmod z"
by (metis Complex.Re_sgn cis.simps(1) assms cis_arg)
lemma sin_arg:
assumes "z ≠ 0"
shows "sin (arg z) = Im z / cmod z"
by (metis Complex.Im_sgn cis.simps(2) assms cis_arg)
text ‹Argument of product›
lemma cis_arg_mult:
assumes "z1 * z2 ≠ 0"
shows "cis (arg (z1 * z2)) = cis (arg z1 + arg z2)"
by (metis assms cis_arg cis_mult mult_eq_0_iff sgn_mult)
lemma arg_mult_2kpi:
assumes "z1 * z2 ≠ 0"
shows "∃ k::int. arg (z1 * z2) = arg z1 + arg z2 + 2*k*pi"
proof-
have "cis (arg (z1*z2)) = cis (arg z1 + arg z2)"
by (rule cis_arg_mult[OF assms])
thus ?thesis
using cis_eq[of "arg (z1*z2)" "arg z1 + arg z2"]
by (auto simp add: field_simps)
qed
lemma arg_mult:
assumes "z1 * z2 ≠ 0"
shows "arg(z1 * z2) = ⇂arg z1 + arg z2⇃"
proof-
obtain k::int where "arg(z1 * z2) = arg z1 + arg z2 + 2*k*pi"
using arg_mult_2kpi[of z1 z2]
using assms
by auto
hence "⇂arg(z1 * z2)⇃ = ⇂arg z1 + arg z2⇃"
using canon_ang_eq
by(simp add:field_simps)
thus ?thesis
using canon_ang_arg[of "z1*z2"]
by auto
qed
lemma arg_mult_real_positive [simp]:
assumes "k > 0"
shows "arg (cor k * z) = arg z"
proof (cases "z = 0")
case False
thus ?thesis
using arg_mult assms canon_ang_arg by force
qed (auto simp: arg_zero)
lemma arg_mult_real_negative [simp]:
assumes "k < 0"
shows "arg (cor k * z) = arg (-z)"
proof (cases "z = 0")
case False
thus ?thesis
using assms
by (metis arg_mult_real_positive minus_mult_commute neg_0_less_iff_less of_real_minus minus_minus)
qed (auto simp: arg_zero)
lemma arg_div_real_positive [simp]:
assumes "k > 0"
shows "arg (z / cor k) = arg z"
proof(cases "z = 0")
case True
thus ?thesis
by auto
next
case False
thus ?thesis
using assms
using arg_mult_real_positive[of "1/k" z]
by auto
qed
lemma arg_div_real_negative [simp]:
assumes "k < 0"
shows "arg (z / cor k) = arg (-z)"
proof(cases "z = 0")
case True
thus ?thesis
by auto
next
case False
thus ?thesis
using assms
using arg_mult_real_negative[of "1/k" z]
by auto
qed
lemma arg_mult_eq:
assumes "z * z1 ≠ 0" and "z * z2 ≠ 0"
assumes "arg (z * z1) = arg (z * z2)"
shows "arg z1 = arg z2"
by (metis (no_types, lifting) arg_cis assms canon_ang_arg cis_arg mult_eq_0_iff nonzero_mult_div_cancel_left sgn_divide)
text ‹Argument of conjugate›
lemma arg_cnj_pi:
assumes "arg z = pi"
shows "arg (cnj z) = pi"
using arg_pi_iff assms by auto
lemma arg_cnj_not_pi:
assumes "arg z ≠ pi"
shows "arg (cnj z) = -arg z"
proof(cases "arg z = 0")
case True
thus ?thesis
using eq_cnj_iff_real[of z] is_real_arg1[of z] by force
next
case False
have "arg (cnj z) = arg z ∨ arg(cnj z) = -arg z"
using arg_bounded[of z] arg_bounded[of "cnj z"]
by (smt (verit, best) arccos_cos arccos_cos2 cnj.sel(1) complex_cnj_zero_iff complex_mod_cnj cos_arg)
moreover
have "arg (cnj z) ≠ arg z"
using sin_0_iff_canon[of "arg (cnj z)"] arg_bounded False assms
by (metis complex_mod_cnj eq_cnj_iff_real is_real_arg2 rcis_cmod_arg)
ultimately
show ?thesis
by auto
qed
text ‹Argument of reciprocal›
lemma arg_inv_not_pi:
assumes "z ≠ 0" and "arg z ≠ pi"
shows "arg (1 / z) = - arg z"
proof-
have "1/z = cnj z / cor ((cmod z)⇧2 )"
using ‹z ≠ 0› complex_mult_cnj_cmod[of z]
by (auto simp add:field_simps)
thus ?thesis
using arg_div_real_positive[of "(cmod z)⇧2" "cnj z"] ‹z ≠ 0›
using arg_cnj_not_pi[of z] ‹arg z ≠ pi›
by auto
qed
lemma arg_inv_pi:
assumes "z ≠ 0" and "arg z = pi"
shows "arg (1 / z) = pi"
proof-
have "1/z = cnj z / cor ((cmod z)⇧2 )"
using ‹z ≠ 0› complex_mult_cnj_cmod[of z]
by (auto simp add:field_simps)
thus ?thesis
using arg_div_real_positive[of "(cmod z)⇧2" "cnj z"] ‹z ≠ 0›
using arg_cnj_pi[of z] ‹arg z = pi›
by auto
qed
lemma arg_inv_2kpi:
assumes "z ≠ 0"
shows "∃ k::int. arg (1 / z) = - arg z + 2*k*pi"
using arg_inv_pi[OF assms]
using arg_inv_not_pi[OF assms]
by (cases "arg z = pi") (rule_tac x="1" in exI, simp, rule_tac x="0" in exI, simp)
lemma arg_inv:
assumes "z ≠ 0"
shows "arg (1 / z) = ⇂- arg z⇃"
by (metis arg_inv_not_pi arg_inv_pi assms canon_ang_arg canon_ang_uminus_pi)
text ‹Argument of quotient›
lemma arg_div_2kpi:
assumes "z1 ≠ 0" and "z2 ≠ 0"
shows "∃ k::int. arg (z1 / z2) = arg z1 - arg z2 + 2*k*pi"
proof-
obtain x1 where "arg (z1 * (1 / z2)) = arg z1 + arg (1 / z2) + 2 * real_of_int x1 * pi"
using assms arg_mult_2kpi[of z1 "1/z2"]
by auto
moreover
obtain x2 where "arg (1 / z2) = - arg z2 + 2 * real_of_int x2 * pi"
using assms arg_inv_2kpi[of z2]
by auto
ultimately
show ?thesis
by (rule_tac x="x1 + x2" in exI, simp add: field_simps)
qed
lemma arg_div:
assumes "z1 ≠ 0" and "z2 ≠ 0"
shows "arg(z1 / z2) = ⇂arg z1 - arg z2⇃"
proof-
obtain k::int where "arg(z1 / z2) = arg z1 - arg z2 + 2*k*pi"
using arg_div_2kpi[of z1 z2]
using assms
by auto
hence "canon_ang(arg(z1 / z2)) = canon_ang(arg z1 - arg z2)"
using canon_ang_eq
by(simp add:field_simps)
thus ?thesis
using canon_ang_arg[of "z1/z2"]
by auto
qed
text ‹Argument of opposite›
lemma arg_uminus:
assumes "z ≠ 0"
shows "arg (-z) = ⇂arg z + pi⇃"
using assms
using arg_mult[of "-1" z]
using arg_complex_of_real_negative[of "-1"]
by (auto simp add: field_simps)
lemma arg_uminus_opposite_sign:
assumes "z ≠ 0"
shows "arg z > 0 ⟷ ¬ arg (-z) > 0"
proof (cases "arg z = 0")
case True
thus ?thesis
using assms
by (simp add: arg_uminus)
next
case False
show ?thesis
proof (cases "arg z > 0")
case True
thus ?thesis
using assms
using arg_bounded[of z]
using canon_ang_plus_pi1[of "arg z"]
by (simp add: arg_uminus)
next
case False
thus ?thesis
using ‹arg z ≠ 0›
using assms
using arg_bounded[of z]
using canon_ang_plus_pi2[of "arg z"]
by (simp add: arg_uminus)
qed
qed
text ‹Sign of argument is the same as the sign of the Imaginary part›
lemma arg_Im_sgn:
assumes "¬ is_real z"
shows "sgn (arg z) = sgn (Im z)"
proof-
have "z ≠ 0"
using assms
by auto
then obtain r φ where polar: "z = cor r * cis φ" "φ = arg z" "r > 0"
by (smt cmod_cis mult_eq_0_iff norm_ge_zero of_real_0)
hence "Im z = r * sin φ"
by (metis Im_mult_real Re_complex_of_real cis.simps(2) Im_complex_of_real)
hence "Im z > 0 ⟷ sin φ > 0" "Im z < 0 ⟷ sin φ < 0"
using ‹r > 0›
using mult_pos_pos mult_nonneg_nonneg zero_less_mult_pos mult_less_cancel_left
by smt+
moreover
have "φ ≠ pi" "φ ≠ 0"
using ‹¬ is_real z› polar cis_pi
by force+
hence "sin φ > 0 ⟷ φ > 0" "φ < 0 ⟷ sin φ < 0"
using ‹φ = arg z› ‹φ ≠ 0› ‹φ ≠ pi›
using arg_bounded[of z]
by (smt sin_gt_zero sin_le_zero sin_pi_minus sin_0_iff_canon sin_ge_zero)+
ultimately
show ?thesis
using ‹φ = arg z›
by auto
qed
subsubsection ‹Complex square root›
definition
"ccsqrt z = rcis (sqrt (cmod z)) (arg z / 2)"
lemma square_ccsqrt [simp]:
shows "(ccsqrt x)⇧2 = x"
unfolding ccsqrt_def
by (subst DeMoivre2) (simp add: rcis_cmod_arg)
lemma ex_complex_sqrt:
shows "∃ s::complex. s*s = z"
unfolding power2_eq_square[symmetric]
by (rule_tac x="csqrt z" in exI) simp
lemma ccsqrt:
assumes "s * s = z"
shows "s = ccsqrt z ∨ s = -ccsqrt z"
proof (cases "s = 0")
case True
thus ?thesis
using assms
unfolding ccsqrt_def
by simp
next
case False
then obtain k::int where "cmod s * cmod s = cmod z" "2 * arg s - arg z = 2*k*pi"
using assms
using rcis_cmod_arg[of z] rcis_cmod_arg[of s]
using arg_mult[of s s]
using canon_ang(3)[of "2*arg s"]
by (auto simp add: norm_mult arg_mult)
have *: "sqrt (cmod z) = cmod s"
using ‹cmod s * cmod s = cmod z›
by (smt norm_not_less_zero real_sqrt_abs2)
have **: "arg z / 2 = arg s - k*pi"
using ‹2 * arg s - arg z = 2*k*pi›
by simp
have "cis (arg s - k*pi) = cis (arg s) ∨ cis (arg s - k*pi) = -cis (arg s)"
proof (cases "even k")
case True
hence "cis (arg s - k*pi) = cis (arg s)"
by (simp add: cis_def complex.corec cos_diff sin_diff)
thus ?thesis
by simp
next
case False
hence "cis (arg s - k*pi) = -cis (arg s)"
by (simp add: cis_def complex.corec Complex_eq cos_diff sin_diff)
thus ?thesis
by simp
qed
thus ?thesis
proof
assume ***: "cis (arg s - k * pi) = cis (arg s)"
hence "s = ccsqrt z"
using rcis_cmod_arg[of s]
unfolding ccsqrt_def rcis_def
by (subst *, subst **, subst ***, simp)
thus ?thesis
by simp
next
assume ***: "cis (arg s - k * pi) = -cis (arg s)"
hence "s = - ccsqrt z"
using rcis_cmod_arg[of s]
unfolding ccsqrt_def rcis_def
by (subst *, subst **, subst ***, simp)
thus ?thesis
by simp
qed
qed
lemma null_ccsqrt [simp]:
shows "ccsqrt x = 0 ⟷ x = 0"
unfolding ccsqrt_def
by auto
lemma ccsqrt_mult:
shows "ccsqrt (a * b) = ccsqrt a * ccsqrt b ∨
ccsqrt (a * b) = - ccsqrt a * ccsqrt b"
proof (cases "a = 0 ∨ b = 0")
case True
thus ?thesis
by auto
next
case False
obtain k::int where "arg a + arg b - ⇂arg a + arg b⇃ = 2 * real_of_int k * pi"
using canon_ang(3)[of "arg a + arg b"]
by auto
hence *: "⇂arg a + arg b⇃ = arg a + arg b - 2 * (real_of_int k) * pi"
by (auto simp add: field_simps)
have "cis (⇂arg a + arg b⇃ / 2) = cis (arg a / 2 + arg b / 2) ∨ cis (⇂arg a + arg b⇃ / 2) = - cis (arg a / 2 + arg b / 2)"
using cos_even_kpi[of k] cos_odd_kpi[of k]
by ((subst *)+, (subst diff_divide_distrib)+, (subst add_divide_distrib)+)
(cases "even k", auto simp add: cis_def complex.corec Complex_eq cos_diff sin_diff)
thus ?thesis
using False
unfolding ccsqrt_def
by (smt (verit, best) arg_mult mult_minus_left mult_minus_right no_zero_divisors norm_mult rcis_def rcis_mult real_sqrt_mult)
qed
lemma csqrt_real:
assumes "is_real x"
shows "(Re x ≥ 0 ∧ ccsqrt x = cor (sqrt (Re x))) ∨
(Re x < 0 ∧ ccsqrt x = 𝗂 * cor (sqrt (- (Re x))))"
proof (cases "x = 0")
case True
thus ?thesis
by auto
next
case False
show ?thesis
proof (cases "Re x > 0")
case True
hence "arg x = 0"
using ‹is_real x›
by (metis arg_complex_of_real_positive complex_of_real_Re)
thus ?thesis
using ‹Re x > 0› ‹is_real x›
unfolding ccsqrt_def
by (simp add: cmod_eq_Re)
next
case False
hence "Re x < 0"
using ‹x ≠ 0› ‹is_real x›
using complex_eq_if_Re_eq by auto
hence "arg x = pi"
using ‹is_real x›
by (metis arg_complex_of_real_negative complex_of_real_Re)
thus ?thesis
using ‹Re x < 0› ‹is_real x›
unfolding ccsqrt_def rcis_def
by (simp add: cis_def complex.corec Complex_eq cmod_eq_Re)
qed
qed
text ‹Rotation of complex vector to x-axis.›
lemma is_real_rot_to_x_axis:
assumes "z ≠ 0"
shows "is_real (cis (-arg z) * z)"
proof (cases "arg z = pi")
case True
thus ?thesis
using is_real_arg1[of z]
by auto
next
case False
hence "⇂- arg z⇃ = - arg z"
using canon_ang_eqI[of "- arg z" "-arg z"]
using arg_bounded[of z]
by (auto simp add: field_simps)
hence "arg (cis (- (arg z)) * z) = 0"
using arg_mult[of "cis (- (arg z))" z] ‹z ≠ 0›
using arg_cis[of "- arg z"]
by simp
thus ?thesis
using is_real_arg1[of "cis (- arg z) * z"]
by auto
qed
lemma positive_rot_to_x_axis:
assumes "z ≠ 0"
shows "Re (cis (-arg z) * z) > 0"
using assms
by (smt Re_complex_of_real cis_rcis_eq mult_cancel_right1 rcis_cmod_arg rcis_mult rcis_zero_arg zero_less_norm_iff)
text ‹Inequalities involving @{term cmod}.›
lemma cmod_1_plus_mult_le:
shows "cmod (1 + z*w) ≤ sqrt((1 + (cmod z)⇧2) * (1 + (cmod w)⇧2))"
proof-
have "Re ((1+z*w)*(1+cnj z*cnj w)) ≤ Re (1+z*cnj z)* Re (1+w*cnj w)"
proof-
have "Re ((w - cnj z)*cnj(w - cnj z)) ≥ 0"
by (subst complex_mult_cnj_cmod) (simp add: power2_eq_square)
hence "Re (z*w + cnj z * cnj w) ≤ Re (w*cnj w) + Re(z*cnj z)"
by (simp add: field_simps)
thus ?thesis
by (simp add: field_simps)
qed
hence "(cmod (1 + z * w))⇧2 ≤ (1 + (cmod z)⇧2) * (1 + (cmod w)⇧2)"
by (subst cmod_square)+ simp
thus ?thesis
by (metis abs_norm_cancel real_sqrt_abs real_sqrt_le_iff)
qed
lemma cmod_diff_ge:
shows "cmod (b - c) ≥ sqrt (1 + (cmod b)⇧2) - sqrt (1 + (cmod c)⇧2)"
proof-
have "(cmod (b - c))⇧2 + (1/2*Im(b*cnj c - c*cnj b))⇧2 ≥ 0"
by simp
hence "(cmod (b - c))⇧2 ≥ - (1/2*Im(b*cnj c - c*cnj b))⇧2"
by simp
hence "(cmod (b - c))⇧2 ≥ (1/2*Re(b*cnj c + c*cnj b))⇧2 - Re(b*cnj b*c*cnj c) "
by (auto simp add: power2_eq_square field_simps)
hence "Re ((b - c)*(cnj b - cnj c)) ≥ (1/2*Re(b*cnj c + c*cnj b))⇧2 - Re(b*cnj b*c*cnj c)"
by (subst (asm) cmod_square) simp
moreover
have "(1 + (cmod b)⇧2) * (1 + (cmod c)⇧2) = 1 + Re(b*cnj b) + Re(c*cnj c) + Re(b*cnj b*c*cnj c)"
by (subst cmod_square)+ (simp add: field_simps power2_eq_square)
moreover
have "(1 + Re (scalprod b c))⇧2 = 1 + 2*Re(scalprod b c) + ((Re (scalprod b c))⇧2)"
by (subst power2_sum) simp
hence "(1 + Re (scalprod b c))⇧2 = 1 + Re(b*cnj c + c*cnj b) + (1/2 * Re (b*cnj c + c*cnj b))⇧2"
by simp
ultimately
have "(1 + (cmod b)⇧2) * (1 + (cmod c)⇧2) ≥ (1 + Re (scalprod b c))⇧2"
by (simp add: field_simps)
moreover
have "sqrt((1 + (cmod b)⇧2) * (1 + (cmod c)⇧2)) ≥ 0"
by (metis one_power2 real_sqrt_sum_squares_mult_ge_zero)
ultimately
have "sqrt((1 + (cmod b)⇧2) * (1 + (cmod c)⇧2)) ≥ 1 + Re (scalprod b c)"
by (metis power2_le_imp_le real_sqrt_ge_0_iff real_sqrt_pow2_iff)
hence "Re ((b - c) * (cnj b - cnj c)) ≥ 1 + Re (c*cnj c) + 1 + Re (b*cnj b) - 2*sqrt((1 + (cmod b)⇧2) * (1 + (cmod c)⇧2))"
by (simp add: field_simps)
hence *: "(cmod (b - c))⇧2 ≥ (sqrt (1 + (cmod b)⇧2) - sqrt (1 + (cmod c)⇧2))⇧2"
apply (subst cmod_square)+
apply (subst (asm) cmod_square)+
apply (subst power2_diff)
apply (subst real_sqrt_pow2, simp)
apply (subst real_sqrt_pow2, simp)
apply (simp add: real_sqrt_mult)
done
thus ?thesis
proof (cases "sqrt (1 + (cmod b)⇧2) - sqrt (1 + (cmod c)⇧2) > 0")
case True
thus ?thesis
using power2_le_imp_le[OF *]
by simp
next
case False
hence "0 ≥ sqrt (1 + (cmod b)⇧2) - sqrt (1 + (cmod c)⇧2)"
by (metis less_eq_real_def linorder_neqE_linordered_idom)
moreover
have "cmod (b - c) ≥ 0"
by simp
ultimately
show ?thesis
by (metis add_increasing monoid_add_class.add.right_neutral)
qed
qed
lemma cmod_diff_le:
shows "cmod (b - c) ≤ sqrt (1 + (cmod b)⇧2) + sqrt (1 + (cmod c)⇧2)"
proof-
have "(cmod (b + c))⇧2 + (1/2*Im(b*cnj c - c*cnj b))⇧2 ≥ 0"
by simp
hence "(cmod (b + c))⇧2 ≥ - (1/2*Im(b*cnj c - c*cnj b))⇧2"
by simp
hence "(cmod (b + c))⇧2 ≥ (1/2*Re(b*cnj c + c*cnj b))⇧2 - Re(b*cnj b*c*cnj c) "
by (auto simp add: power2_eq_square field_simps)
hence "Re ((b + c)*(cnj b + cnj c)) ≥ (1/2*Re(b*cnj c + c*cnj b))⇧2 - Re(b*cnj b*c*cnj c)"
by (subst (asm) cmod_square) simp
moreover
have "(1 + (cmod b)⇧2) * (1 + (cmod c)⇧2) = 1 + Re(b*cnj b) + Re(c*cnj c) + Re(b*cnj b*c*cnj c)"
by (subst cmod_square)+ (simp add: field_simps power2_eq_square)
moreover
have ++: "2*Re(scalprod b c) = Re(b*cnj c + c*cnj b)"
by simp
have "(1 - Re (scalprod b c))⇧2 = 1 - 2*Re(scalprod b c) + ((Re (scalprod b c))⇧2)"
by (subst power2_diff) simp
hence "(1 - Re (scalprod b c))⇧2 = 1 - Re(b*cnj c + c*cnj b) + (1/2 * Re (b*cnj c + c*cnj b))⇧2"
by (subst ++[symmetric]) simp
ultimately
have "(1 + (cmod b)⇧2) * (1 + (cmod c)⇧2) ≥ (1 - Re (scalprod b c))⇧2"
by (simp add: field_simps)
moreover
have "sqrt((1 + (cmod b)⇧2) * (1 + (cmod c)⇧2)) ≥ 0"
by (metis one_power2 real_sqrt_sum_squares_mult_ge_zero)
ultimately
have "sqrt((1 + (cmod b)⇧2) * (1 + (cmod c)⇧2)) ≥ 1 - Re (scalprod b c)"
by (metis power2_le_imp_le real_sqrt_ge_0_iff real_sqrt_pow2_iff)
hence "Re ((b - c) * (cnj b - cnj c)) ≤ 1 + Re (c*cnj c) + 1 + Re (b*cnj b) + 2*sqrt((1 + (cmod b)⇧2) * (1 + (cmod c)⇧2))"
by (simp add: field_simps)
hence *: "(cmod (b - c))⇧2 ≤ (sqrt (1 + (cmod b)⇧2) + sqrt (1 + (cmod c)⇧2))⇧2"
apply (subst cmod_square)+
apply (subst (asm) cmod_square)+
apply (subst power2_sum)
apply (subst real_sqrt_pow2, simp)
apply (subst real_sqrt_pow2, simp)
apply (simp add: real_sqrt_mult)
done
thus ?thesis
using power2_le_imp_le[OF *]
by simp
qed
text ‹Definition of Euclidean distance between two complex numbers.›
definition cdist where
[simp]: "cdist z1 z2 ≡ cmod (z2 - z1)"
text ‹Misc. properties of complex numbers.›
lemma ex_complex_to_complex [simp]:
fixes z1 z2 :: complex
assumes "z1 ≠ 0" and "z2 ≠ 0"
shows "∃k. k ≠ 0 ∧ z2 = k * z1"
using assms
by (rule_tac x="z2/z1" in exI) simp
lemma ex_complex_to_one [simp]:
fixes z::complex
assumes "z ≠ 0"
shows "∃k. k ≠ 0 ∧ k * z = 1"
using assms
by (rule_tac x="1/z" in exI) simp
lemma ex_complex_to_complex2 [simp]:
fixes z::complex
shows "∃k. k ≠ 0 ∧ k * z = z"
by (rule_tac x="1" in exI) simp
lemma complex_sqrt_1:
fixes z::complex
assumes "z ≠ 0"
shows "z = 1 / z ⟷ z = 1 ∨ z = -1"
using assms
using nonzero_eq_divide_eq square_eq_iff
by fastforce
end
Theory Angles
subsection ‹Angle between two vectors›
text ‹In this section we introduce different measures of angle between two vectors (represented by complex numbers).›
theory Angles
imports More_Transcendental Canonical_Angle More_Complex
begin
subsubsection ‹Oriented angle›
text ‹Oriented angle between two vectors (it is always in the interval $(-\pi, \pi]$).›
definition ang_vec ("∠") where
[simp]: "∠ z1 z2 ≡ ⇂arg z2 - arg z1⇃"
lemma ang_vec_bounded:
shows "-pi < ∠ z1 z2 ∧ ∠ z1 z2 ≤ pi"
by (simp add: canon_ang(1) canon_ang(2))
lemma ang_vec_sym:
assumes "∠ z1 z2 ≠ pi"
shows "∠ z1 z2 = - ∠ z2 z1"
using assms
unfolding ang_vec_def
using canon_ang_uminus[of "arg z2 - arg z1"]
by simp
lemma ang_vec_sym_pi:
assumes "∠ z1 z2 = pi"
shows "∠ z1 z2 = ∠ z2 z1"
using assms
unfolding ang_vec_def
using canon_ang_uminus_pi[of "arg z2 - arg z1"]
by simp
lemma ang_vec_plus_pi1:
assumes "∠ z1 z2 > 0"
shows "⇂∠ z1 z2 + pi⇃ = ∠ z1 z2 - pi"
proof (rule canon_ang_eqI)
show "∃ x::int. ∠ z1 z2 - pi - (∠ z1 z2 + pi) = 2 * real_of_int x * pi"
by (rule_tac x="-1" in exI) auto
next
show "- pi < ∠ z1 z2 - pi ∧ ∠ z1 z2 - pi ≤ pi"
using assms
unfolding ang_vec_def
using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
by auto
qed
lemma ang_vec_plus_pi2:
assumes "∠ z1 z2 ≤ 0"
shows "⇂∠ z1 z2 + pi⇃ = ∠ z1 z2 + pi"
proof (rule canon_ang_id)
show "- pi < ∠ z1 z2 + pi ∧ ∠ z1 z2 + pi ≤ pi"
using assms
unfolding ang_vec_def
using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
by auto
qed
lemma ang_vec_opposite1:
assumes "z1 ≠ 0"
shows "∠ (-z1) z2 = ⇂∠ z1 z2 - pi⇃"
proof-
have "∠ (-z1) z2 = ⇂arg z2 - (arg z1 + pi)⇃"
unfolding ang_vec_def
using arg_uminus[OF assms]
using canon_ang_arg[of z2, symmetric]
using canon_ang_diff[of "arg z2" "arg z1 + pi", symmetric]
by simp
moreover
have "⇂∠ z1 z2 - pi⇃ = ⇂arg z2 - arg z1 - pi⇃"
using canon_ang_id[of pi, symmetric]
using canon_ang_diff[of "arg z2 - arg z1" "pi", symmetric]
by simp_all
ultimately
show ?thesis
by (simp add: field_simps)
qed
lemma ang_vec_opposite2:
assumes "z2 ≠ 0"
shows "∠ z1 (-z2) = ⇂∠ z1 z2 + pi⇃"
unfolding ang_vec_def
using arg_mult[of "-1" "z2"] assms
using arg_complex_of_real_negative[of "-1"]
using canon_ang_diff[of "arg (-1) + arg z2" "arg z1", symmetric]
using canon_ang_sum[of "arg z2 - arg z1" "pi", symmetric]
using canon_ang_id[of pi] canon_ang_arg[of z1]
by (auto simp: algebra_simps)
lemma ang_vec_opposite_opposite:
assumes "z1 ≠ 0" and "z2 ≠ 0"
shows "∠ (-z1) (-z2) = ∠ z1 z2"
proof-
have "∠ (-z1) (-z2) = ⇂⇂∠ z1 z2 + pi⇃ - ⇂pi⇃⇃"
using ang_vec_opposite1[OF assms(1)]
using ang_vec_opposite2[OF assms(2)]
using canon_ang_id[of pi, symmetric]
by simp_all
also have "... = ⇂∠ z1 z2⇃"
by (subst canon_ang_diff[symmetric], simp)
finally
show ?thesis
by (metis ang_vec_def canon_ang(1) canon_ang(2) canon_ang_id)
qed
lemma ang_vec_opposite_opposite':
assumes "z1 ≠ z" and "z2 ≠ z"
shows "∠ (z - z1) (z - z2) = ∠ (z1 - z) (z2 - z)"
using ang_vec_opposite_opposite[of "z - z1" "z - z2"] assms
by (simp add: field_simps del: ang_vec_def)
text ‹Cosine, scalar product and the law of cosines›
lemma cos_cmod_scalprod:
shows "cmod z1 * cmod z2 * (cos (∠ z1 z2)) = Re (scalprod z1 z2)"
proof (cases "z1 = 0 ∨ z2 = 0")
case True
thus ?thesis
by auto
next
case False
thus ?thesis
by (simp add: cos_diff cos_arg sin_arg field_simps)
qed
lemma cos0_scalprod0:
assumes "z1 ≠ 0" and "z2 ≠ 0"
shows "cos (∠ z1 z2) = 0 ⟷ scalprod z1 z2 = 0"
using assms
using cnj_mix_real[of z1 z2]
using cos_cmod_scalprod[of z1 z2]
by (auto simp add: complex_eq_if_Re_eq)
lemma ortho_scalprod0:
assumes "z1 ≠ 0" and "z2 ≠ 0"
shows "∠ z1 z2 = pi/2 ∨ ∠ z1 z2 = -pi/2 ⟷ scalprod z1 z2 = 0"
using cos0_scalprod0[OF assms]
using ang_vec_bounded[of z1 z2]
using cos_0_iff_canon[of "∠ z1 z2"]
by (metis cos_minus cos_pi_half divide_minus_left)
lemma law_of_cosines:
shows "(cdist B C)⇧2 = (cdist A C)⇧2 + (cdist A B)⇧2 - 2*(cdist A C)*(cdist A B)*(cos (∠ (C-A) (B-A)))"
proof-
let ?a = "C-B" and ?b = "C-A" and ?c = "B-A"
have "?a = ?b - ?c"
by simp
hence "(cmod ?a)⇧2 = (cmod (?b - ?c))⇧2"
by metis
also have "... = Re (scalprod (?b-?c) (?b-?c))"
by (simp add: cmod_square)
also have "... = (cmod ?b)⇧2 + (cmod ?c)⇧2 - 2*Re (scalprod ?b ?c)"
by (simp add: cmod_square field_simps)
finally
show ?thesis
using cos_cmod_scalprod[of ?b ?c]
by simp
qed
subsubsection ‹Unoriented angle›
text ‹Convex unoriented angle between two vectors (it is always in the interval $[0, pi]$).›
definition ang_vec_c ("∠c") where
[simp]:"∠c z1 z2 ≡ abs (∠ z1 z2)"
lemma ang_vec_c_sym:
shows "∠c z1 z2 = ∠c z2 z1"
unfolding ang_vec_c_def
using ang_vec_sym_pi[of z1 z2] ang_vec_sym[of z1 z2]
by (cases "∠ z1 z2 = pi") auto
lemma ang_vec_c_bounded: "0 ≤ ∠c z1 z2 ∧ ∠c z1 z2 ≤ pi"
using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
by auto
text ‹Cosine and scalar product›
lemma cos_c_: "cos (∠c z1 z2) = cos (∠ z1 z2)"
unfolding ang_vec_c_def
by (smt cos_minus)
lemma ortho_c_scalprod0:
assumes "z1 ≠ 0" and "z2 ≠ 0"
shows "∠c z1 z2 = pi/2 ⟷ scalprod z1 z2 = 0"
proof-
have "∠ z1 z2 = pi / 2 ∨ ∠ z1 z2 = - pi / 2 ⟷ ∠c z1 z2 = pi/2"
unfolding ang_vec_c_def
using arctan
by force
thus ?thesis
using ortho_scalprod0[OF assms]
by simp
qed
subsubsection ‹Acute angle›
text ‹Acute or right angle (non-obtuse) between two vectors (it is always in the interval $[0, \frac{\pi}{2}$]).
We will use this to measure angle between two circles, since it can always be acute (or right).›
definition acute_ang where
[simp]: "acute_ang α = (if α > pi / 2 then pi - α else α)"
definition ang_vec_a ("∠a") where
[simp]: "∠a z1 z2 ≡ acute_ang (∠c z1 z2)"
lemma ang_vec_a_sym:
"∠a z1 z2 = ∠a z2 z1"
unfolding ang_vec_a_def
using ang_vec_c_sym
by auto
lemma ang_vec_a_opposite2:
"∠a z1 z2 = ∠a z1 (-z2)"
proof(cases "z2 = 0")
case True
thus ?thesis
by (metis minus_zero)
next
case False
thus ?thesis
proof(cases "∠ z1 z2 < -pi / 2")
case True
hence "∠ z1 z2 < 0"
using pi_not_less_zero
by linarith
have "∠a z1 z2 = pi + ∠ z1 z2"
using True ‹∠ z1 z2 < 0›
unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
by auto
moreover
have "∠a z1 (-z2) = pi + ∠ z1 z2"
unfolding ang_vec_a_def ang_vec_c_def abs_real_def
using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
using ang_vec_plus_pi2[of z1 z2] True ‹∠ z1 z2 < 0› ‹z2 ≠ 0›
using ang_vec_opposite2[of z2 z1]
by auto
ultimately
show ?thesis
by auto
next
case False
show ?thesis
proof (cases "∠ z1 z2 ≤ 0")
case True
have "∠a z1 z2 = - ∠ z1 z2"
using ‹¬ ∠ z1 z2 < - pi / 2› True
unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
by auto
moreover
have "∠a z1 (-z2) = - ∠ z1 z2"
using ‹¬ ∠ z1 z2 < - pi / 2› True
unfolding ang_vec_a_def ang_vec_c_def abs_real_def
using ang_vec_plus_pi2[of z1 z2]
using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
using ‹z2 ≠ 0› ang_vec_opposite2[of z2 z1]
by auto
ultimately
show ?thesis
by simp
next
case False
show ?thesis
proof (cases "∠ z1 z2 < pi / 2")
case True
have "∠a z1 z2 = ∠ z1 z2"
using ‹¬ ∠ z1 z2 ≤ 0› True
unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
by auto
moreover
have "∠a z1 (-z2) = ∠ z1 z2"
using ‹¬ ∠ z1 z2 ≤ 0› True
unfolding ang_vec_a_def ang_vec_c_def abs_real_def
using ang_vec_plus_pi1[of z1 z2]
using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
using ‹z2 ≠ 0› ang_vec_opposite2[of z2 z1]
by auto
ultimately
show ?thesis
by simp
next
case False
have "∠ z1 z2 > 0"
using False
by (metis less_linear less_trans pi_half_gt_zero)
have "∠a z1 z2 = pi - ∠ z1 z2"
using False ‹∠ z1 z2 > 0›
unfolding ang_vec_a_def ang_vec_c_def ang_vec_a_def abs_real_def
by auto
moreover
have "∠a z1 (-z2) = pi - ∠ z1 z2"
unfolding ang_vec_a_def ang_vec_c_def abs_real_def
using False ‹∠ z1 z2 > 0›
using ang_vec_plus_pi1[of z1 z2]
using canon_ang(1)[of "arg z2 - arg z1"] canon_ang(2)[of "arg z2 - arg z1"]
using ‹z2 ≠ 0› ang_vec_opposite2[of z2 z1]
by auto
ultimately
show ?thesis
by auto
qed
qed
qed
qed
lemma ang_vec_a_opposite1:
shows "∠a z1 z2 = ∠a (-z1) z2"
using ang_vec_a_sym[of "-z1" z2] ang_vec_a_opposite2[of z2 z1] ang_vec_a_sym[of z2 z1]
by auto
lemma ang_vec_a_scale1:
assumes "k ≠ 0"
shows "∠a (cor k * z1) z2 = ∠a z1 z2"
proof (cases "k > 0")
case True
thus ?thesis
unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
using arg_mult_real_positive[of k z1]
by auto
next
case False
hence "k < 0"
using assms
by auto
thus ?thesis
using arg_mult_real_negative[of k z1]
using ang_vec_a_opposite1[of z1 z2]
unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
by simp
qed
lemma ang_vec_a_scale2:
assumes "k ≠ 0"
shows "∠a z1 (cor k * z2) = ∠a z1 z2"
using ang_vec_a_sym[of z1 "complex_of_real k * z2"]
using ang_vec_a_scale1[OF assms, of z2 z1]
using ang_vec_a_sym[of z1 z2]
by auto
lemma ang_vec_a_scale:
assumes "k1 ≠ 0" and "k2 ≠ 0"
shows "∠a (cor k1 * z1) (cor k2 * z2) = ∠a z1 z2"
using ang_vec_a_scale1[OF assms(1)] ang_vec_a_scale2[OF assms(2)]
by auto
lemma ang_a_cnj_cnj:
shows "∠a z1 z2 = ∠a (cnj z1) (cnj z2)"
unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
proof(cases "arg z1 ≠ pi ∧ arg z2 ≠ pi")
case True
thus "acute_ang ¦⇂arg z2 - arg z1⇃¦ = acute_ang ¦⇂arg (cnj z2) - arg (cnj z1)⇃¦"
using arg_cnj_not_pi[of z1] arg_cnj_not_pi[of z2]
apply (auto simp del:acute_ang_def)
proof(cases "⇂arg z2 - arg z1⇃ = pi")
case True
thus "acute_ang ¦⇂arg z2 - arg z1⇃¦ = acute_ang ¦⇂arg z1 - arg z2⇃¦"
using canon_ang_uminus_pi[of "arg z2 - arg z1"]
by (auto simp add:field_simps)
next
case False
thus "acute_ang ¦⇂arg z2 - arg z1⇃¦ = acute_ang ¦⇂arg z1 - arg z2⇃¦"
using canon_ang_uminus[of "arg z2 - arg z1"]
by (auto simp add:field_simps)
qed
next
case False
thus "acute_ang ¦⇂arg z2 - arg z1⇃¦ = acute_ang ¦⇂arg (cnj z2) - arg (cnj z1)⇃¦"
proof(cases "arg z1 = pi")
case False
hence "arg z2 = pi"
using ‹ ¬ (arg z1 ≠ pi ∧ arg z2 ≠ pi)›
by auto
thus ?thesis
using False
using arg_cnj_not_pi[of z1] arg_cnj_pi[of z2]
apply (auto simp del:acute_ang_def)
proof(cases "arg z1 > 0")
case True
hence "-arg z1 ≤ 0"
by auto
thus "acute_ang ¦⇂pi - arg z1⇃¦ = acute_ang ¦⇂pi + arg z1⇃¦"
using True canon_ang_plus_pi1[of "arg z1"]
using arg_bounded[of z1] canon_ang_plus_pi2[of "-arg z1"]
by (auto simp add:field_simps)
next
case False
hence "-arg z1 ≥ 0"
by simp
thus "acute_ang ¦⇂pi - arg z1⇃¦ = acute_ang ¦⇂pi + arg z1⇃¦"
proof(cases "arg z1 = 0")
case True
thus ?thesis
by (auto simp del:acute_ang_def)
next
case False
hence "-arg z1 > 0"
using ‹-arg z1 ≥ 0›
by auto
thus ?thesis
using False canon_ang_plus_pi1[of "-arg z1"]
using arg_bounded[of z1] canon_ang_plus_pi2[of "arg z1"]
by (auto simp add:field_simps)
qed
qed
next
case True
thus ?thesis
using arg_cnj_pi[of z1]
apply (auto simp del:acute_ang_def)
proof(cases "arg z2 = pi")
case True
thus "acute_ang ¦⇂arg z2 - pi⇃¦ = acute_ang ¦⇂arg (cnj z2) - pi⇃¦"
using arg_cnj_pi[of z2]
by auto
next
case False
thus "acute_ang ¦⇂arg z2 - pi⇃¦ = acute_ang ¦⇂arg (cnj z2) - pi⇃¦"
using arg_cnj_not_pi[of z2]
apply (auto simp del:acute_ang_def)
proof(cases "arg z2 > 0")
case True
hence "-arg z2 ≤ 0"
by auto
thus "acute_ang ¦⇂arg z2 - pi⇃¦ = acute_ang ¦⇂- arg z2 - pi⇃¦"
using True canon_ang_minus_pi1[of "arg z2"]
using arg_bounded[of z2] canon_ang_minus_pi2[of "-arg z2"]
by (auto simp add: field_simps)
next
case False
hence "-arg z2 ≥ 0"
by simp
thus "acute_ang ¦⇂arg z2 - pi⇃¦ = acute_ang ¦⇂- arg z2 - pi⇃¦"
proof(cases "arg z2 = 0")
case True
thus ?thesis
by (auto simp del:acute_ang_def)
next
case False
hence "-arg z2 > 0"
using ‹-arg z2 ≥ 0›
by auto
thus ?thesis
using False canon_ang_minus_pi1[of "-arg z2"]
using arg_bounded[of z2] canon_ang_minus_pi2[of "arg z2"]
by (auto simp add:field_simps)
qed
qed
qed
qed
qed
text ‹Cosine and scalar product›
lemma ortho_a_scalprod0:
assumes "z1 ≠ 0" and "z2 ≠ 0"
shows "∠a z1 z2 = pi/2 ⟷ scalprod z1 z2 = 0"
unfolding ang_vec_a_def
using assms ortho_c_scalprod0[of z1 z2]
by auto
declare ang_vec_c_def[simp del]
lemma cos_a_c: "cos (∠a z1 z2) = abs (cos (∠c z1 z2))"
proof-
have "0 ≤ ∠c z1 z2" "∠c z1 z2 ≤ pi"
using ang_vec_c_bounded[of z1 z2]
by auto
show ?thesis
proof (cases "∠c z1 z2 = pi/2")
case True
thus ?thesis
unfolding ang_vec_a_def acute_ang_def
by (smt cos_pi_half pi_def pi_half)
next
case False
show ?thesis
proof (cases "∠c z1 z2 < pi / 2")
case True
thus ?thesis
using ‹0 ≤ ∠c z1 z2›
using cos_gt_zero_pi[of "∠c z1 z2"]
unfolding ang_vec_a_def
by simp
next
case False
hence "∠c z1 z2 > pi/2"
using ‹∠c z1 z2 ≠ pi/2›
by simp
hence "cos (∠c z1 z2) < 0"
using ‹∠c z1 z2 ≤ pi›
using cos_lt_zero_on_pi2_pi[of "∠c z1 z2"]
by simp
thus ?thesis
using ‹∠c z1 z2 > pi/2›
unfolding ang_vec_a_def
by simp
qed
qed
qed
end
Theory More_Set
subsection ‹Library Aditions for Set Cardinality›
text ‹In this section some additional simple lemmas about set cardinality are proved.›
theory More_Set
imports Main
begin
text ‹Every infinite set has at least two different elements›
lemma infinite_contains_2_elems:
assumes "infinite A"
shows "∃ x y. x ≠ y ∧ x ∈ A ∧ y ∈ A"
by (metis assms finite.simps is_singletonI' is_singleton_def)
text ‹Every infinite set has at least three different elements›
lemma infinite_contains_3_elems:
assumes "infinite A"
shows "∃ x y z. x ≠ y ∧ x ≠ z ∧ y ≠ z ∧ x ∈ A ∧ y ∈ A ∧ z ∈ A"
by (metis Diff_iff assms infinite_contains_2_elems infinite_remove insertI1)
text ‹Every set with cardinality greater than 1 has at least two different elements›
lemma card_geq_2_iff_contains_2_elems:
shows "card A ≥ 2 ⟷ finite A ∧ (∃ x y. x ≠ y ∧ x ∈ A ∧ y ∈ A)"
proof (intro iffI conjI)
assume *: "finite A ∧ (∃ x y. x ≠ y ∧ x ∈ A ∧ y ∈ A)"
thus "card A ≥ 2"
by (metis card_0_eq card_Suc_eq empty_iff leI less_2_cases singletonD)
next
assume *: "2 ≤ card A"
then show "finite A"
using card.infinite by force
show "∃ x y. x ≠ y ∧ x ∈ A ∧ y ∈ A"
by (meson "*" card_2_iff' in_mono obtain_subset_with_card_n)
qed
text ‹Set cardinality is at least 3 if and only if it contains three different elements›
lemma card_geq_3_iff_contains_3_elems:
shows "card A ≥ 3 ⟷ finite A ∧ (∃ x y z. x ≠ y ∧ x ≠ z ∧ y ≠ z ∧ x ∈ A ∧ y ∈ A ∧ z ∈ A)"
proof (intro iffI conjI)
assume *: "card A ≥ 3"
then show "finite A"
using card.infinite by force
show "∃ x y z. x ≠ y ∧ x ≠ z ∧ y ≠ z ∧ x ∈ A ∧ y ∈ A ∧ z ∈ A"
by (smt (verit, best) "*" card_2_iff' card_geq_2_iff_contains_2_elems le_cases3 not_less_eq_eq numeral_2_eq_2 numeral_3_eq_3)
next
assume *: "finite A ∧ (∃ x y z. x ≠ y ∧ x ≠ z ∧ y ≠ z ∧ x ∈ A ∧ y ∈ A ∧ z ∈ A)"
thus "card A ≥ 3"
by (metis One_nat_def Suc_le_eq card_2_iff' card_le_Suc0_iff_eq leI numeral_3_eq_3 one_add_one order_class.order.eq_iff plus_1_eq_Suc)
qed
text ‹Set cardinality of A is equal to 2 if and only if A={x, y} for two different elements x and y›
lemma card_eq_2_iff_doubleton: "card A = 2 ⟷ (∃ x y. x ≠ y ∧ A = {x, y})"
using card_geq_2_iff_contains_2_elems[of A]
using card_geq_3_iff_contains_3_elems[of A]
by auto (rule_tac x=x in exI, rule_tac x=y in exI, auto)
lemma card_eq_2_doubleton:
assumes "card A = 2" and "x ≠ y" and "x ∈ A" and "y ∈ A"
shows "A = {x, y}"
using assms card_eq_2_iff_doubleton[of A]
by auto
text ‹Bijections map singleton to singleton sets›
lemma bij_image_singleton:
shows "⟦f ` A = {b}; f a = b; bij f⟧ ⟹ A = {a}"
by (metis bij_betw_def image_empty image_insert inj_image_eq_iff)
end
Theory Linear_Systems
subsection ‹Systems of linear equations›
text ‹In this section some simple properties of systems of linear equations with two or three unknowns are derived.
Existence and uniqueness of solutions of regular and singular homogenous and non-homogenous systems is characterized.›
theory Linear_Systems
imports Main
begin
text ‹Determinant of 2x2 matrix›
definition det2 :: "('a::field) ⇒ 'a ⇒ 'a ⇒ 'a ⇒ 'a" where
[simp]: "det2 a11 a12 a21 a22 ≡ a11*a22 - a12*a21"
text ‹Regular homogenous system has only trivial solution›
lemma regular_homogenous_system:
fixes a11 a12 a21 a22 x1 x2 :: "'a::field"
assumes "det2 a11 a12 a21 a22 ≠ 0"
assumes "a11*x1 + a12*x2 = 0" and
"a21*x1 + a22*x2 = 0"
shows "x1 = 0 ∧ x2 = 0"
proof (cases "a11 = 0")
case True
with assms(1) have "a12 ≠ 0" "a21 ≠ 0"
by auto
thus ?thesis
using ‹a11 = 0› assms(2) assms(3)
by auto
next
case False
hence "x1 = - a12*x2 / a11"
using assms(2)
by (metis eq_neg_iff_add_eq_0 mult_minus_left nonzero_mult_div_cancel_left)
hence "a21 * (- a12 * x2 / a11) + a22 * x2 = 0"
using assms(3)
by simp
hence "a21 * (- a12 * x2) + a22 * x2 * a11 = 0"
using ‹a11 ≠ 0›
by auto
hence "(a11*a22 - a12*a21)*x2 = 0"
by (simp add: field_simps)
thus ?thesis
using assms(1) assms(2) ‹a11 ≠ 0›
by auto
qed
text ‹Regular system has a unique solution›
lemma regular_system:
fixes a11 a12 a21 a22 b1 b2 :: "'a::field"
assumes "det2 a11 a12 a21 a22 ≠ 0"
shows "∃! x. a11*(fst x) + a12*(snd x) = b1 ∧
a21*(fst x) + a22*(snd x) = b2"
proof
let ?d = "a11*a22 - a12*a21" and ?d1 = "b1*a22 - b2*a12" and ?d2 = "b2*a11 - b1*a21"
let ?x = "(?d1 / ?d, ?d2 / ?d)"
have "a11 * ?d1 + a12 * ?d2 = b1*?d" "a21 * ?d1 + a22 * ?d2 = b2*?d"
by (auto simp add: field_simps)
thus "a11 * fst ?x + a12 * snd ?x = b1 ∧ a21 * fst ?x + a22 * snd ?x = b2"
using assms
by (metis (hide_lams, no_types) det2_def add_divide_distrib eq_divide_imp fst_eqD snd_eqD times_divide_eq_right)
fix x'
assume "a11 * fst x' + a12 * snd x' = b1 ∧ a21 * fst x' + a22 * snd x' = b2"
with ‹a11 * fst ?x + a12 * snd ?x = b1 ∧ a21 * fst ?x + a22 * snd ?x = b2›
have "a11 * (fst x' - fst ?x) + a12 * (snd x' - snd ?x) = 0 ∧ a21 * (fst x' - fst ?x) + a22 * (snd x' - snd ?x) = 0"
by (auto simp add: field_simps)
thus "x' = ?x"
using regular_homogenous_system[OF assms, of "fst x' - fst ?x" "snd x' - snd ?x"]
by (cases x') auto
qed
text ‹Singular system does not have a unique solution›
lemma singular_system:
fixes a11 a12 a21 a22 ::"'a::field"
assumes "det2 a11 a12 a21 a22 = 0" and "a11 ≠ 0 ∨ a12 ≠ 0"
assumes x0: "a11*fst x0 + a12*snd x0 = b1"
"a21*fst x0 + a22*snd x0 = b2"
assumes x: "a11*fst x + a12*snd x = b1"
shows "a21*fst x + a22*snd x = b2"
proof (cases "a11 = 0")
case True
with assms have "a21 = 0" "a12 ≠ 0"
by auto
let ?k = "a22 / a12"
have "b2 = ?k * b1"
using x0 ‹a11 = 0› ‹a21 = 0› ‹a12 ≠ 0›
by auto
thus ?thesis
using ‹a11 = 0› ‹a21 = 0› ‹a12 ≠ 0› x
by auto
next
case False
let ?k = "a21 / a11"
from x
have "?k * a11 * fst x + ?k * a12 * snd x = ?k * b1"
using ‹a11 ≠ 0›
by (auto simp add: field_simps)
moreover
have "a21 = ?k * a11" "a22 = ?k * a12" "b2 = ?k * b1"
using assms(1) x0 ‹a11 ≠ 0›
by (auto simp add: field_simps)
ultimately
show ?thesis
by auto
qed
text ‹All solutions of a homogenous system of 2 equations with 3 unknows are proportional›
lemma linear_system_homogenous_3_2:
fixes a11 a12 a13 a21 a22 a23 x1 y1 z1 x2 y2 z2 :: "'a::field"
assumes "f1 = (λ x y z. a11 * x + a12 * y + a13 * z)"
assumes "f2 = (λ x y z. a21 * x + a22 * y + a23 * z)"
assumes "f1 x1 y1 z1 = 0" and "f2 x1 y1 z1 = 0"
assumes "f1 x2 y2 z2 = 0" and "f2 x2 y2 z2 = 0"
assumes "x2 ≠ 0 ∨ y2 ≠ 0 ∨ z2 ≠ 0"
assumes "det2 a11 a12 a21 a22 ≠ 0 ∨ det2 a11 a13 a21 a23 ≠ 0 ∨ det2 a12 a13 a22 a23 ≠ 0"
shows "∃ k. x1 = k * x2 ∧ y1 = k * y2 ∧ z1 = k * z2"
proof-
let ?Dz = "det2 a11 a12 a21 a22"
let ?Dy = "det2 a11 a13 a21 a23"
let ?Dx = "det2 a12 a13 a22 a23"
have "a21 * (f1 x1 y1 z1) - a11 * (f2 x1 y1 z1) = 0"
using assms
by simp
hence yz1: "?Dz*y1 + ?Dy*z1 = 0"
using assms
by (simp add: field_simps)
have "a21 * (f1 x2 y2 z2) - a11 * (f2 x2 y2 z2) = 0"
using assms
by simp
hence yz2: "?Dz*y2 + ?Dy*z2 = 0"
using assms
by (simp add: field_simps)
have "a22 * (f1 x1 y1 z1) - a12 * (f2 x1 y1 z1) = 0"
using assms
by simp
hence xz1: "-?Dz*x1 + ?Dx*z1 = 0"
using assms
by (simp add: field_simps)
have "a22 * (f1 x2 y2 z2) - a12 * (f2 x2 y2 z2) = 0"
using assms
by simp
hence xz2: "-?Dz*x2 + ?Dx*z2 = 0"
using assms
by (simp add: field_simps)
have "a23 * (f1 x1 y1 z1) - a13 * (f2 x1 y1 z1) = 0"
using assms
by simp
hence xy1: "?Dy*x1 + ?Dx*y1 = 0"
using assms
by (simp add: field_simps)
have "a23 * (f1 x2 y2 z2) - a13 * (f2 x2 y2 z2) = 0"
using assms
by simp
hence xy2: "?Dy*x2 + ?Dx*y2 = 0"
using assms
by (simp add: field_simps)
show ?thesis
using ‹?Dz ≠ 0 ∨ ?Dy ≠ 0 ∨ ?Dx ≠ 0›
proof safe
assume "?Dz ≠ 0"
hence *:
"x2 = (?Dx / ?Dz) * z2" "y2 = - (?Dy / ?Dz) * z2"
"x1 = (?Dx / ?Dz) * z1" "y1 = - (?Dy / ?Dz) * z1"
using xy2 xz2 xy1 xz1 yz1 yz2
by (simp_all add: field_simps)
hence "z2 ≠ 0"
using ‹x2 ≠ 0 ∨ y2 ≠ 0 ∨ z2 ≠ 0›
by auto
thus ?thesis
using * ‹?Dz ≠ 0›
by (rule_tac x="z1/z2" in exI) auto
next
assume "?Dy ≠ 0"
hence *:
"x2 = - (?Dx / ?Dy) * y2" "z2 = - (?Dz / ?Dy) * y2"
"x1 = - (?Dx / ?Dy) * y1" "z1 = - (?Dz / ?Dy) * y1"
using xy2 xz2 xy1 xz1 yz1 yz2
by (simp_all add: field_simps)
hence "y2 ≠ 0"
using ‹x2 ≠ 0 ∨ y2 ≠ 0 ∨ z2 ≠ 0›
by auto
thus ?thesis
using * ‹?Dy ≠ 0›
by (rule_tac x="y1/y2" in exI) auto
next
assume "?Dx ≠ 0"
hence *:
"y2 = - (?Dy / ?Dx) * x2" "z2 = (?Dz / ?Dx) * x2"
"y1 = - (?Dy / ?Dx) * x1" "z1 = (?Dz / ?Dx) * x1"
using xy2 xz2 xy1 xz1 yz1 yz2
by (simp_all add: field_simps)
hence "x2 ≠ 0"
using ‹x2 ≠ 0 ∨ y2 ≠ 0 ∨ z2 ≠ 0›
by auto
thus ?thesis
using * ‹?Dx ≠ 0›
by (rule_tac x="x1/x2" in exI) auto
qed
qed
end
Theory Quadratic
subsection ‹Quadratic equations›
text ‹In this section some simple properties of quadratic equations and their roots are derived.
Quadratic equations over reals and over complex numbers, but also systems of quadratic equations and
systems of quadratic and linear equations are analysed.›
theory Quadratic
imports More_Complex "HOL-Library.Quadratic_Discriminant"
begin
subsubsection ‹Real quadratic equations, Viette rules›
lemma viette2_monic:
fixes b c ξ1 ξ2 :: real
assumes "b⇧2 - 4*c ≥ 0" and "ξ1⇧2 + b*ξ1 + c = 0" and "ξ2⇧2 + b*ξ2 + c = 0" and "ξ1 ≠ ξ2"
shows "ξ1*ξ2 = c"
using assms
by algebra
lemma viette2:
fixes a b c ξ1 ξ2 :: real
assumes "a ≠ 0" and "b⇧2 - 4*a*c ≥ 0" and "a*ξ1⇧2 + b*ξ1 + c = 0" and "a*ξ2⇧2 + b*ξ2 + c = 0" and "ξ1 ≠ ξ2"
shows "ξ1*ξ2 = c/a"
proof (rule viette2_monic[of "b/a" "c/a" ξ1 ξ2])
have "(b / a)⇧2 - 4 * (c / a) = (b⇧2 - 4*a*c) / a⇧2"
using ‹a ≠ 0›
by (auto simp add: power2_eq_square field_simps)
thus "0 ≤ (b / a)⇧2 - 4 * (c / a)"
using ‹b⇧2 - 4*a*c ≥ 0›
by simp
next
show "ξ1⇧2 + b / a * ξ1 + c / a = 0" "ξ2⇧2 + b / a * ξ2 + c / a = 0"
using assms
by (auto simp add: power2_eq_square field_simps)
next
show "ξ1 ≠ ξ2"
by fact
qed
lemma viette2'_monic:
fixes b c ξ :: real
assumes "b⇧2 - 4*c = 0" and "ξ⇧2 + b*ξ + c = 0"
shows "ξ*ξ = c"
using assms
by algebra
lemma viette2':
fixes a b c ξ :: real
assumes "a ≠ 0" and "b⇧2 - 4*a*c = 0" and "a*ξ⇧2 + b*ξ + c = 0"
shows "ξ*ξ = c/a"
proof (rule viette2'_monic)
have "(b / a)⇧2 - 4 * (c / a) = (b⇧2 - 4*a*c) / a⇧2"
using ‹a ≠ 0›
by (auto simp add: power2_eq_square field_simps)
thus "(b / a)⇧2 - 4 * (c / a) = 0"
using ‹b⇧2 - 4*a*c = 0›
by simp
next
show "ξ⇧2 + b / a * ξ + c / a = 0"
using assms
by (auto simp add: power2_eq_square field_simps)
qed
subsubsection ‹Complex quadratic equations›
lemma complex_quadratic_equation_monic_only_two_roots:
fixes ξ :: complex
assumes "ξ⇧2 + b * ξ + c = 0"
shows "ξ = (-b + ccsqrt(b⇧2 - 4*c)) / 2 ∨ ξ = (-b - ccsqrt(b⇧2 - 4*c)) / 2"
using assms
proof-
from assms have "(2 * (ξ + b/2))⇧2 = b⇧2 - 4*c"
by (simp add: power2_eq_square field_simps)
(metis (no_types, lifting) distrib_right_numeral mult.assoc mult_zero_left)
hence "2 * (ξ + b/2) = ccsqrt (b⇧2 - 4*c) ∨ 2 * (ξ + b/2) = - ccsqrt (b⇧2 - 4*c)"
using ccsqrt[of "(2 * (ξ + b / 2))" "b⇧2 - 4 * c"]
by (simp add: power2_eq_square)
thus ?thesis
using mult_cancel_right[of "b + ξ * 2" 2 "ccsqrt (b⇧2 - 4*c)"]
using mult_cancel_right[of "b + ξ * 2" 2 "-ccsqrt (b⇧2 - 4*c)"]
by (auto simp add: field_simps) (metis add_diff_cancel diff_minus_eq_add minus_diff_eq)
qed
lemma complex_quadratic_equation_monic_roots:
fixes ξ :: complex
assumes "ξ = (-b + ccsqrt(b⇧2 - 4*c)) / 2 ∨
ξ = (-b - ccsqrt(b⇧2 - 4*c)) / 2"
shows "ξ⇧2 + b * ξ + c = 0"
using assms
proof
assume *: "ξ = (- b + ccsqrt (b⇧2 - 4 * c)) / 2"
show ?thesis
by ((subst *)+) (subst power_divide, subst power2_sum, simp add: field_simps, simp add: power2_eq_square)
next
assume *: "ξ = (- b - ccsqrt (b⇧2 - 4 * c)) / 2"
show ?thesis
by ((subst *)+, subst power_divide, subst power2_diff, simp add: field_simps, simp add: power2_eq_square)
qed
lemma complex_quadratic_equation_monic_distinct_roots:
fixes b c :: complex
assumes "b⇧2 - 4*c ≠ 0"
shows "∃ k⇩1 k⇩2. k⇩1 ≠ k⇩2 ∧ k⇩1⇧2 + b*k⇩1 + c = 0 ∧ k⇩2⇧2 + b*k⇩2 + c = 0"
proof-
let ?ξ1 = "(-b + ccsqrt(b⇧2 - 4*c)) / 2"
let ?ξ2 = "(-b - ccsqrt(b⇧2 - 4*c)) / 2"
show ?thesis
apply (rule_tac x="?ξ1" in exI)
apply (rule_tac x="?ξ2" in exI)
using assms
using complex_quadratic_equation_monic_roots[of ?ξ1 b c]
using complex_quadratic_equation_monic_roots[of ?ξ2 b c]
by simp
qed
lemma complex_quadratic_equation_two_roots:
fixes ξ :: complex
assumes "a ≠ 0" and "a*ξ⇧2 + b * ξ + c = 0"
shows "ξ = (-b + ccsqrt(b⇧2 - 4*a*c)) / (2*a) ∨
ξ = (-b - ccsqrt(b⇧2 - 4*a*c)) / (2*a)"
proof-
from assms have "ξ⇧2 + (b/a) * ξ + (c/a) = 0"
by (simp add: field_simps)
hence "ξ = (-(b/a) + ccsqrt((b/a)⇧2 - 4*(c/a))) / 2 ∨ ξ = (-(b/a) - ccsqrt((b/a)⇧2 - 4*(c/a))) / 2"
using complex_quadratic_equation_monic_only_two_roots[of ξ "b/a" "c/a"]
by simp
hence "∃ k. ξ = (-(b/a) + (-1)^k * ccsqrt((b/a)⇧2 - 4*(c/a))) / 2"
by safe (rule_tac x="2" in exI, simp, rule_tac x="1" in exI, simp)
then obtain k1 where "ξ = (-(b/a) + (-1)^k1 * ccsqrt((b/a)⇧2 - 4*(c/a))) / 2"
by auto
moreover
have "(b / a)⇧2 - 4 * (c / a) = (b⇧2 - 4 * a * c) * (1 / a⇧2)"
using ‹a ≠ 0›
by (simp add: field_simps power2_eq_square)
hence "ccsqrt ((b / a)⇧2 - 4 * (c / a)) = ccsqrt (b⇧2 - 4 * a * c) * ccsqrt (1/a⇧2) ∨
ccsqrt ((b / a)⇧2 - 4 * (c / a)) = - ccsqrt (b⇧2 - 4 * a * c) * ccsqrt (1/a⇧2)"
using ccsqrt_mult[of "b⇧2 - 4 * a * c" "1/a⇧2"]
by auto
hence "∃ k. ccsqrt ((b / a)⇧2 - 4 * (c / a)) = (-1)^k * ccsqrt (b⇧2 - 4 * a * c) * ccsqrt (1 / a⇧2)"
by safe (rule_tac x="2" in exI, simp, rule_tac x="1" in exI, simp)
then obtain k2 where "ccsqrt ((b / a)⇧2 - 4 * (c / a)) = (-1)^k2 * ccsqrt (b⇧2 - 4 * a * c) * ccsqrt (1 / a⇧2)"
by auto
moreover
have "ccsqrt (1 / a⇧2) = 1/a ∨ ccsqrt (1 / a⇧2) = -1/a"
using ccsqrt[of "1/a" "1 / a⇧2"]
by (auto simp add: power2_eq_square)
hence "∃ k. ccsqrt (1 / a⇧2) = (-1)^k * 1/a"
by safe (rule_tac x="2" in exI, simp, rule_tac x="1" in exI, simp)
then obtain k3 where "ccsqrt (1 / a⇧2) = (-1)^k3 * 1/a"
by auto
ultimately
have "ξ = (- (b / a) + ((-1) ^ k1 * (-1) ^ k2 * (-1) ^ k3) * ccsqrt (b⇧2 - 4 * a * c) * 1/a) / 2"
by simp
moreover
have "(-(1::complex)) ^ k1 * (-1) ^ k2 * (-1) ^ k3 = 1 ∨ (-(1::complex)) ^ k1 * (-1) ^ k2 * (-1) ^ k3 = -1"
using neg_one_even_power[of "k1 + k2 + k3"]
using neg_one_odd_power[of "k1 + k2 + k3"]
by (smt power_add)
ultimately
have "ξ = (- (b / a) + ccsqrt (b⇧2 - 4 * a * c) * 1 / a) / 2 ∨ ξ = (- (b / a) - ccsqrt (b⇧2 - 4 * a * c) * 1 / a) / 2"
by auto
thus ?thesis
using ‹a ≠ 0›
by (simp add: field_simps)
qed
lemma complex_quadratic_equation_only_two_roots:
fixes x :: complex
assumes "a ≠ 0"
assumes "qf = (λ x. a*x⇧2 + b*x + c)"
"qf x1 = 0" and "qf x2 = 0" and "x1 ≠ x2"
"qf x = 0"
shows "x = x1 ∨ x = x2"
using assms
using complex_quadratic_equation_two_roots
by blast
subsubsection ‹Intersections of linear and quadratic forms›
lemma quadratic_linear_at_most_2_intersections_help:
fixes x y :: complex
assumes "(a11, a12, a22) ≠ (0, 0, 0)" and "k2 ≠ 0"
"qf = (λ x y. a11*x⇧2 + 2*a12*x*y + a22*y⇧2 + b1*x + b2*y + c)" and "lf = (λ x y. k1*x + k2*y + n)"
"qf x y = 0" and "lf x y = 0"
"pf = (λ x. (a11 - 2*a12*k1/k2 + a22*k1⇧2/k2⇧2)*x⇧2 + (-2*a12*n/k2 + b1 + a22*2*n*k1/k2⇧2 - b2*k1/k2)*x + a22*n⇧2/k2⇧2 - b2*n/k2 + c)"
"yf = (λ x. (-n - k1*x) / k2)"
shows "pf x = 0" and "y = yf x"
proof -
show "y = yf x"
using assms
by (simp add:field_simps eq_neg_iff_add_eq_0)
next
have "2*a12*x*(-n - k1*x)/k2 = (-2*a12*n/k2)*x - (2*a12*k1/k2)*x⇧2"
by algebra
have "a22*((-n - k1*x)/k2)⇧2 = a22*n⇧2/k2⇧2 + (a22*2*n*k1/k2⇧2)*x + (a22*k1⇧2/k2⇧2)*x⇧2"
by (simp add: power_divide) algebra
have "2*a12*x*(-n - k1*x)/k2 = (-2*a12*n/k2)*x - (2*a12*k1/k2)*x⇧2"
by algebra
have "b2*(-n - k1*x)/k2 = -b2*n/k2 - (b2*k1/k2)*x"
by algebra
have *: "y = (-n - k1*x)/k2"
using assms(2, 4, 6)
by (simp add:field_simps eq_neg_iff_add_eq_0)
have "0 = a11*x⇧2 + 2*a12*x*y + a22*y⇧2 + b1*x + b2*y + c"
using assms
by simp
hence "0 = a11*x⇧2 + 2*a12*x*(-n - k1*x)/k2 + a22*((-n - k1*x)/k2)⇧2 + b1*x + b2*(-n - k1*x)/k2 + c"
by (subst (asm) *, subst (asm) *, subst (asm) *) auto
also have "... = (a11 - 2*a12*k1/k2 + a22*k1⇧2/k2⇧2)*x⇧2 + (-2*a12*n/k2 + b1 + a22*2*n*k1/k2⇧2 - b2*k1/k2)*x + a22*n⇧2/k2⇧2 -b2*n/k2 + c"
using ‹2*a12*x*(-n - k1*x)/k2 = (-2*a12*n/k2)*x - (2*a12*k1/k2)*x⇧2›
using ‹a22*((-n - k1*x)/k2)⇧2 = a22*n⇧2/k2⇧2 + (a22*2*n*k1/k2⇧2)*x + (a22*k1⇧2/k2⇧2)*x⇧2›
using ‹b2*(-n - k1*x)/k2 = -b2*n/k2 - (b2*k1/k2)*x›
by (simp add:field_simps)
finally show "pf x = 0"
using assms(7)
by auto
qed
lemma quadratic_linear_at_most_2_intersections_help':
fixes x y :: complex
assumes "qf = (λ x y. a11*x⇧2 + 2*a12*x*y + a22*y⇧2 + b1*x + b2*y + c)"
"x = -n/k1" and "k1 ≠ 0" and "qf x y = 0"
"yf = (λ y. k1⇧2*a22*y⇧2 + (-2*a12*n*k1 + b2*k1⇧2)*y + a11*n⇧2 - b1*n*k1 + c*k1⇧2)"
shows "yf y = 0"
proof-
have "0 = a11*n⇧2/k1⇧2 - 2*a12*n*y/k1 + a22*y⇧2 - b1*n/k1 + b2*y + c"
using assms(1, 2, 4)
by (simp add: power_divide)
hence "0 = a11*n⇧2 - 2*a12*n*k1*y + a22*y⇧2*k1⇧2 - b1*n*k1 + b2*y*k1⇧2 + c*k1⇧2"
using assms(3)
apply (simp add:field_simps power2_eq_square)
by algebra
thus ?thesis
using assms(1, 4, 5)
by (simp add:field_simps)
qed
lemma quadratic_linear_at_most_2_intersections:
fixes x y x1 y1 x2 y2 :: complex
assumes "(a11, a12, a22) ≠ (0, 0, 0)" and "(k1, k2) ≠ (0, 0)"
assumes "a11*k2⇧2 - 2*a12*k1*k2 + a22*k1⇧2 ≠ 0"
assumes "qf = (λ x y. a11*x⇧2 + 2*a12*x*y + a22*y⇧2 + b1*x + b2*y + c)" and "lf = (λ x y. k1*x + k2*y + n)"
"qf x1 y1 = 0" and "lf x1 y1 = 0"
"qf x2 y2 = 0" and "lf x2 y2 = 0"
"(x1, y1) ≠ (x2, y2)"
"qf x y = 0" and "lf x y = 0"
shows "(x, y) = (x1, y1) ∨ (x, y) = (x2, y2)"
proof(cases "k2 = 0")
case True
hence "k1 ≠ 0"
using assms(2)
by simp
have "a22*k1⇧2 ≠ 0"
using assms(3) True
by auto
have "x1 = -n/k1"
using ‹k1 ≠ 0› assms(5, 7) True
by (metis add.right_neutral add_eq_0_iff2 mult_zero_left nonzero_mult_div_cancel_left)
have "x2 = -n/k1"
using ‹k1 ≠ 0› assms(5, 9) True
by (metis add.right_neutral add_eq_0_iff2 mult_zero_left nonzero_mult_div_cancel_left)
have "x = -n/k1"
using ‹k1 ≠ 0› assms(5, 12) True
by (metis add.right_neutral add_eq_0_iff2 mult_zero_left nonzero_mult_div_cancel_left)
let ?yf = "(λ y. k1⇧2*a22*y⇧2 + (-2*a12*n*k1 + b2*k1⇧2)*y + a11*n⇧2 - b1*n*k1 + c*k1⇧2)"
have "?yf y = 0"
using quadratic_linear_at_most_2_intersections_help'[of qf a11 a12 a22 b1 b2 c x n k1 y ?yf]
using assms(4, 11) ‹k1 ≠ 0› ‹x = -n/k1›
by auto
have "?yf y1 = 0"
using quadratic_linear_at_most_2_intersections_help'[of qf a11 a12 a22 b1 b2 c x1 n k1 y1 ?yf]
using assms(4, 6) ‹k1 ≠ 0› ‹x1 = -n/k1›
by auto
have "?yf y2 = 0"
using quadratic_linear_at_most_2_intersections_help'[of qf a11 a12 a22 b1 b2 c x2 n k1 y2 ?yf]
using assms(4, 8) ‹k1 ≠ 0› ‹x2 = -n/k1›
by auto
have "y1 ≠ y2"
using assms(10) ‹x1 = -n/k1› ‹x2 = -n/k1›
by blast
have "y = y1 ∨ y = y2"
using complex_quadratic_equation_only_two_roots[of "a22*k1⇧2" ?yf "-2*a12*n*k1 + b2*k1⇧2" "a11*n⇧2 - b1*n*k1 + c*k1⇧2"
y1 y2 y]
using ‹a22*k1⇧2 ≠ 0› ‹?yf y1 = 0› ‹y1 ≠ y2› ‹?yf y2 = 0› ‹?yf y = 0›
by fastforce
thus ?thesis
using ‹x1 = -n/k1› ‹x2 = -n/k1› ‹x = -n/k1›
by auto
next
case False
let ?py = "(λ x. (-n - k1*x)/k2)"
let ?pf = "(λ x. (a11 - 2*a12*k1/k2 + a22*k1⇧2/k2⇧2)*x⇧2 + (-2*a12*n/k2 + b1 + a22*2*n*k1/k2⇧2 - b2*k1/k2)*x + a22*n⇧2/k2⇧2 -b2*n/k2 + c)"
have "?pf x1 = 0" "y1 = ?py x1"
using quadratic_linear_at_most_2_intersections_help[of a11 a12 a22 k2 qf b1 b2 c lf k1 n x1 y1]
using assms(1, 4, 5, 6, 7) False
by auto
have "?pf x2 = 0" "y2 = ?py x2"
using quadratic_linear_at_most_2_intersections_help[of a11 a12 a22 k2 qf b1 b2 c lf k1 n x2 y2]
using assms(1, 4, 5, 8, 9) False
by auto
have "?pf x = 0" "y = ?py x"
using quadratic_linear_at_most_2_intersections_help[of a11 a12 a22 k2 qf b1 b2 c lf k1 n x y]
using assms(1, 4, 5, 11, 12) False
by auto
have "x1 ≠ x2"
using assms(10) ‹y1 = ?py x1› ‹y2 = ?py x2›
by auto
have "a11 - 2*a12*k1/k2 + a22*k1⇧2/k2⇧2 = (a11 * k2⇧2 - 2 * a12 * k1 * k2 + a22 * k1⇧2)/k2⇧2"
by (simp add: False power2_eq_square add_divide_distrib diff_divide_distrib)
also have "... ≠ 0"
using False assms(3)
by simp
finally have "a11 - 2*a12*k1/k2 + a22*k1⇧2/k2⇧2 ≠ 0"
.
have "x = x1 ∨ x = x2"
using complex_quadratic_equation_only_two_roots[of "a11 - 2*a12*k1/k2 + a22*k1⇧2/k2⇧2" ?pf
"(- 2 * a12 * n / k2 + b1 + a22 * 2 * n * k1 / k2⇧2 - b2 * k1 / k2)"
"a22 * n⇧2 / k2⇧2 - b2 * n / k2 + c" x1 x2 x]
using ‹?pf x2 = 0› ‹?pf x1 = 0› ‹?pf x = 0›
using ‹a11 - 2 * a12 * k1 / k2 + a22 * k1⇧2 / k2⇧2 ≠ 0›
using ‹x1 ≠ x2›
by fastforce
thus ?thesis
using ‹y = ?py x› ‹y1 = ?py x1› ‹y2 = ?py x2›
by (cases "x = x1", auto)
qed
lemma quadratic_quadratic_at_most_2_intersections':
fixes x y x1 y1 x2 y2 :: complex
assumes "b2 ≠ B2 ∨ b1 ≠ B1"
"(b2 - B2)⇧2 + (b1 - B1)⇧2 ≠ 0"
assumes "qf1 = (λ x y. x⇧2 + y⇧2 + b1*x + b2*y + c)"
"qf2 = (λ x y. x⇧2 + y⇧2 + B1*x + B2*y + C)"
"qf1 x1 y1 = 0" "qf2 x1 y1 = 0"
"qf1 x2 y2 = 0" "qf2 x2 y2 = 0"
"(x1, y1) ≠ (x2, y2)"
"qf1 x y = 0" "qf2 x y = 0"
shows "(x, y) = (x1, y1) ∨ (x, y) = (x2, y2)"
proof-
have "x⇧2 + y⇧2 + b1*x + b2*y + c = 0"
using assms by auto
have "x⇧2 + y⇧2 + B1*x + B2*y + C = 0"
using assms by auto
hence "0 = x⇧2 + y⇧2 + b1*x + b2*y + c - (x⇧2 + y⇧2 + B1*x + B2*y + C)"
using ‹x⇧2 + y⇧2 + b1*x + b2*y + c = 0›
by auto
hence "0 = (b1 - B1)*x + (b2 - B2)*y + c - C"
by (simp add:field_simps)
have "x1⇧2 + y1⇧2 + b1*x1 + b2*y1 + c = 0"
using assms by auto
have "x1⇧2 + y1⇧2 + B1*x1 + B2*y1 + C = 0"
using assms by auto
hence "0 = x1⇧2 + y1⇧2 + b1*x1 + b2*y1 + c - (x1⇧2 + y1⇧2 + B1*x1 + B2*y1 + C)"
using ‹x1⇧2 + y1⇧2 + b1*x1 + b2*y1 + c = 0›
by auto
hence "0 = (b1 - B1)*x1 + (b2 - B2)*y1 + c - C"
by (simp add:field_simps)
have "x2⇧2 + y2⇧2 + b1*x2 + b2*y2 + c = 0"
using assms by auto
have "x2⇧2 + y2⇧2 + B1*x2 + B2*y2 + C = 0"
using assms by auto
hence "0 = x2⇧2 + y2⇧2 + b1*x2 + b2*y2 + c - (x2⇧2 + y2⇧2 + B1*x2 + B2*y2 + C)"
using ‹x2⇧2 + y2⇧2 + b1*x2 + b2*y2 + c = 0›
by auto
hence "0 = (b1 - B1)*x2 + (b2 - B2)*y2 + c - C"
by (simp add:field_simps)
have "(b1 - B1, b2 - B2) ≠ (0, 0)"
using assms(1) by auto
let ?lf = "(λ x y. (b1 - B1)*x + (b2 - B2)*y + c - C)"
have "?lf x y = 0" "?lf x1 y1 = 0" "?lf x2 y2 = 0"
using ‹0 = (b1 - B1)*x2 + (b2 - B2)*y2 + c - C›
‹0 = (b1 - B1)*x1 + (b2 - B2)*y1 + c - C›
‹0 = (b1 - B1)*x + (b2 - B2)*y + c - C›
by auto
thus ?thesis
using quadratic_linear_at_most_2_intersections[of 1 0 1 "b1 - B1" "b2 - B2" qf1 b1 b2 c ?lf "c - C" x1 y1 x2 y2 x y]
using ‹(b1 - B1, b2 - B2) ≠ (0, 0)›
using assms ‹(b1 - B1, b2 - B2) ≠ (0, 0)›
using ‹(b1 - B1) * x + (b2 - B2) * y + c - C = 0› ‹(b1 - B1) * x1 + (b2 - B2) * y1 + c - C = 0›
by (simp add: add_diff_eq)
qed
lemma quadratic_change_coefficients:
fixes x y :: complex
assumes "A1 ≠ 0"
assumes "qf = (λ x y. A1*x⇧2 + A1*y⇧2 + b1*x + b2*y + c)"
"qf x y = 0"
"qf_1 = (λ x y. x⇧2 + y⇧2 + (b1/A1)*x + (b2/A1)*y + c/A1)"
shows "qf_1 x y = 0"
proof-
have "0 = A1*x⇧2 + A1*y⇧2 + b1*x + b2*y + c"
using assms by auto
hence "0/A1 = (A1*x⇧2 + A1*y⇧2 + b1*x + b2*y + c)/A1"
using assms(1) by auto
also have "... = A1*x⇧2/A1 + A1*y⇧2/A1 + b1*x/A1 + b2*y/A1 + c/A1"
by (simp add: add_divide_distrib)
also have "... = x⇧2 + y⇧2 + (b1/A1)*x + (b2/A1)*y + c/A1"
using assms(1)
by (simp add:field_simps)
finally have "0 = x⇧2 + y⇧2 + (b1/A1)*x + (b2/A1)*y + c/A1"
by simp
thus ?thesis
using assms
by simp
qed
lemma quadratic_quadratic_at_most_2_intersections:
fixes x y x1 y1 x2 y2 :: complex
assumes "A1 ≠ 0" and "A2 ≠ 0"
assumes "qf1 = (λ x y. A1*x⇧2 + A1*y⇧2 + b1*x + b2*y + c)" and
"qf2 = (λ x y. A2*x⇧2 + A2*y⇧2 + B1*x + B2*y + C)" and
"qf1 x1 y1 = 0" and "qf2 x1 y1 = 0" and
"qf1 x2 y2 = 0" and "qf2 x2 y2 = 0" and
"(x1, y1) ≠ (x2, y2)" and
"qf1 x y = 0" and "qf2 x y = 0"
assumes "(b2*A2 - B2*A1)⇧2 + (b1*A2 - B1*A1)⇧2 ≠ 0" and
"b2*A2 ≠ B2*A1 ∨ b1*A2 ≠ B1*A1"
shows "(x, y) = (x1, y1) ∨ (x, y) = (x2, y2)"
proof-
have *: "b2 / A1 ≠ B2 / A2 ∨ b1 / A1 ≠ B1 / A2"
using assms(1, 2) assms(13)
by (simp add:field_simps)
have **: "(b2 / A1 - B2 / A2)⇧2 + (b1 / A1 - B1 / A2)⇧2 ≠ 0"
using assms(1, 2) assms(12)
by (simp add:field_simps)
let ?qf_1 = "(λ x y. x⇧2 + y⇧2 + (b1/A1)*x + (b2/A1)*y + c/A1)"
let ?qf_2 = "(λ x y. x⇧2 + y⇧2 + (B1/A2)*x + (B2/A2)*y + C/A2)"
have "?qf_1 x1 y1 = 0" "?qf_1 x2 y2 = 0" "?qf_1 x y = 0"
"?qf_2 x1 y1 = 0" "?qf_2 x2 y2 = 0" "?qf_2 x y = 0"
using assms quadratic_change_coefficients[of A1 qf1 b1 b2 c x2 y2 ?qf_1]
quadratic_change_coefficients[of A1 qf1 b1 b2 c x1 y1 ?qf_1]
quadratic_change_coefficients[of A2 qf2 B1 B2 C x1 y1 ?qf_2]
quadratic_change_coefficients[of A2 qf2 B1 B2 C x2 y2 ?qf_2]
quadratic_change_coefficients[of A1 qf1 b1 b2 c x y ?qf_1]
quadratic_change_coefficients[of A2 qf2 B1 B2 C x y ?qf_2]
by auto
thus ?thesis
using quadratic_quadratic_at_most_2_intersections'
[of "b2 / A1" "B2 / A2" "b1 / A1" "B1 / A2" ?qf_1 "c / A1" ?qf_2 "C / A2" x1 y1 x2 y2 x y]
using * ** ‹(x1, y1) ≠ (x2, y2)›
by fastforce
qed
end
Theory Matrices
subsection ‹Vectors and Matrices in $\mathbb{C}^2$›
text ‹Representing vectors and matrices of arbitrary dimensions pose a challenge in formal theorem
proving \cite{harrison05}, but we only need to consider finite dimension spaces $\mathbb{C}^2$ and
$\mathbb{R}^3$.›
theory Matrices
imports More_Complex Linear_Systems Quadratic
begin
subsubsection ‹Vectors in $\mathbb{C}^2$›
text ‹Type of complex vector›
type_synonym complex_vec = "complex × complex"
definition vec_zero :: "complex_vec" where
[simp]: "vec_zero = (0, 0)"
text ‹Vector scalar multiplication›
fun mult_sv :: "complex ⇒ complex_vec ⇒ complex_vec" (infixl "*⇩s⇩v" 100) where
"k *⇩s⇩v (x, y) = (k*x, k*y)"
lemma fst_mult_sv [simp]:
shows "fst (k *⇩s⇩v v) = k * fst v"
by (cases v) simp
lemma snd_mult_sv [simp]:
shows "snd (k *⇩s⇩v v) = k * snd v"
by (cases v) simp
lemma mult_sv_mult_sv [simp]:
shows "k1 *⇩s⇩v (k2 *⇩s⇩v v) = (k1*k2) *⇩s⇩v v"
by (cases v) simp
lemma one_mult_sv [simp]:
shows "1 *⇩s⇩v v = v"
by (cases v) simp
lemma mult_sv_ex_id1 [simp]:
shows "∃ k::complex. k ≠ 0 ∧ k *⇩s⇩v v = v"
by (rule_tac x=1 in exI, simp)
lemma mult_sv_ex_id2 [simp]:
shows "∃ k::complex. k ≠ 0 ∧ v = k *⇩s⇩v v"
by (rule_tac x=1 in exI, simp)
text ‹Scalar product of two vectors›
fun mult_vv :: "complex × complex ⇒ complex × complex ⇒ complex" (infixl "*⇩v⇩v" 100) where
"(x, y) *⇩v⇩v (a, b) = x*a + y*b"
lemma mult_vv_commute:
shows "v1 *⇩v⇩v v2 = v2 *⇩v⇩v v1"
by (cases v1, cases v2) auto
lemma mult_vv_scale_sv1:
shows "(k *⇩s⇩v v1) *⇩v⇩v v2 = k * (v1 *⇩v⇩v v2)"
by (cases v1, cases v2) (auto simp add: field_simps)
lemma mult_vv_scale_sv2:
shows "v1 *⇩v⇩v (k *⇩s⇩v v2) = k * (v1 *⇩v⇩v v2)"
by (cases v1, cases v2) (auto simp add: field_simps)
text ‹Conjugate vector›
fun vec_map where
"vec_map f (x, y) = (f x, f y)"
definition vec_cnj where
"vec_cnj = vec_map cnj"
lemma vec_cnj_vec_cnj [simp]:
shows "vec_cnj (vec_cnj v) = v"
by (cases v) (simp add: vec_cnj_def)
lemma cnj_mult_vv:
shows "cnj (v1 *⇩v⇩v v2) = (vec_cnj v1) *⇩v⇩v (vec_cnj v2)"
by (cases v1, cases v2) (simp add: vec_cnj_def)
lemma vec_cnj_sv [simp]:
shows "vec_cnj (k *⇩s⇩v A) = cnj k *⇩s⇩v vec_cnj A"
by (cases A) (auto simp add: vec_cnj_def)
lemma scalsquare_vv_zero:
shows "(vec_cnj v) *⇩v⇩v v = 0 ⟷ v = vec_zero"
apply (cases v)
apply (auto simp add: vec_cnj_def field_simps complex_mult_cnj_cmod power2_eq_square)
apply (metis (no_types) norm_eq_zero of_real_0 of_real_add of_real_eq_iff of_real_mult sum_squares_eq_zero_iff)+
done
subsubsection ‹Matrices in $\mathbb{C}^2$›
text ‹Type of complex matrices›
type_synonym complex_mat = "complex × complex × complex × complex"
text ‹Matrix scalar multiplication›
fun mult_sm :: "complex ⇒ complex_mat ⇒ complex_mat" (infixl "*⇩s⇩m" 100) where
"k *⇩s⇩m (a, b, c, d) = (k*a, k*b, k*c, k*d)"
lemma mult_sm_distribution [simp]:
shows "k1 *⇩s⇩m (k2 *⇩s⇩m A) = (k1*k2) *⇩s⇩m A"
by (cases A) auto
lemma mult_sm_neutral [simp]:
shows "1 *⇩s⇩m A = A"
by (cases A) auto
lemma mult_sm_inv_l:
assumes "k ≠ 0" and "k *⇩s⇩m A = B"
shows "A = (1/k) *⇩s⇩m B"
using assms
by auto
lemma mult_sm_ex_id1 [simp]:
shows "∃ k::complex. k ≠ 0 ∧ k *⇩s⇩m M = M"
by (rule_tac x=1 in exI, simp)
lemma mult_sm_ex_id2 [simp]:
shows "∃ k::complex. k ≠ 0 ∧ M = k *⇩s⇩m M"
by (rule_tac x=1 in exI, simp)
text ‹Matrix addition and subtraction›
definition mat_zero :: "complex_mat" where [simp]: "mat_zero = (0, 0, 0, 0)"
fun mat_plus :: "complex_mat ⇒ complex_mat ⇒ complex_mat" (infixl "+⇩m⇩m" 100) where
"mat_plus (a1, b1, c1, d1) (a2, b2, c2, d2) = (a1+a2, b1+b2, c1+c2, d1+d2)"
fun mat_minus :: "complex_mat ⇒ complex_mat ⇒ complex_mat" (infixl "-⇩m⇩m" 100) where
"mat_minus (a1, b1, c1, d1) (a2, b2, c2, d2) = (a1-a2, b1-b2, c1-c2, d1-d2)"
fun mat_uminus :: "complex_mat ⇒ complex_mat" where
"mat_uminus (a, b, c, d) = (-a, -b, -c, -d)"
lemma nonzero_mult_real:
assumes "A ≠ mat_zero" and "k ≠ 0"
shows "k *⇩s⇩m A ≠ mat_zero"
using assms
by (cases A) simp
text ‹Matrix multiplication.›
fun mult_mm :: "complex_mat ⇒ complex_mat ⇒ complex_mat" (infixl "*⇩m⇩m" 100) where
"(a1, b1, c1, d1) *⇩m⇩m (a2, b2, c2, d2) =
(a1*a2 + b1*c2, a1*b2 + b1*d2, c1*a2+d1*c2, c1*b2+d1*d2)"
lemma mult_mm_assoc:
shows "A *⇩m⇩m (B *⇩m⇩m C) = (A *⇩m⇩m B) *⇩m⇩m C"
by (cases A, cases B, cases C) (auto simp add: field_simps)
lemma mult_assoc_5:
shows "A *⇩m⇩m (B *⇩m⇩m C *⇩m⇩m D) *⇩m⇩m E = (A *⇩m⇩m B) *⇩m⇩m C *⇩m⇩m (D *⇩m⇩m E)"
by (simp only: mult_mm_assoc)
lemma mat_zero_r [simp]:
shows "A *⇩m⇩m mat_zero = mat_zero"
by (cases A) simp
lemma mat_zero_l [simp]:
shows "mat_zero *⇩m⇩m A = mat_zero"
by (cases A) simp
definition eye :: "complex_mat" where
[simp]: "eye = (1, 0, 0, 1)"
lemma mat_eye_l:
shows "eye *⇩m⇩m A = A"
by (cases A) auto
lemma mat_eye_r:
shows "A *⇩m⇩m eye = A"
by (cases A) auto
lemma mult_mm_sm [simp]:
shows "A *⇩m⇩m (k *⇩s⇩m B) = k *⇩s⇩m (A *⇩m⇩m B)"
by (cases A, cases B) (simp add: field_simps)
lemma mult_sm_mm [simp]:
shows "(k *⇩s⇩m A) *⇩m⇩m B = k *⇩s⇩m (A *⇩m⇩m B)"
by (cases A, cases B) (simp add: field_simps)
lemma mult_sm_eye_mm [simp]:
shows "k *⇩s⇩m eye *⇩m⇩m A = k *⇩s⇩m A"
by (cases A) simp
text ‹Matrix determinant›
fun mat_det where "mat_det (a, b, c, d) = a*d - b*c"
lemma mat_det_mult [simp]:
shows "mat_det (A *⇩m⇩m B) = mat_det A * mat_det B"
by (cases A, cases B) (auto simp add: field_simps)
lemma mat_det_mult_sm [simp]:
shows "mat_det (k *⇩s⇩m A) = (k*k) * mat_det A"
by (cases A) (auto simp add: field_simps)
text ‹Matrix inverse›
fun mat_inv :: "complex_mat ⇒ complex_mat" where
"mat_inv (a, b, c, d) = (1/(a*d - b*c)) *⇩s⇩m (d, -b, -c, a)"
lemma mat_inv_r:
assumes "mat_det A ≠ 0"
shows "A *⇩m⇩m (mat_inv A) = eye"
using assms
proof (cases A, auto simp add: field_simps)
fix a b c d :: complex
assume "a * (a * (d * d)) + b * (b * (c * c)) = a * (b * (c * (d * 2)))"
hence "(a*d - b*c)*(a*d - b*c) = 0"
by (auto simp add: field_simps)
hence *: "a*d - b*c = 0"
by auto
assume "a*d ≠ b*c"
with * show False
by auto
qed
lemma mat_inv_l:
assumes "mat_det A ≠ 0"
shows "(mat_inv A) *⇩m⇩m A = eye"
using assms
proof (cases A, auto simp add: field_simps)
fix a b c d :: complex
assume "a * (a * (d * d)) + b * (b * (c * c)) = a * (b * (c * (d * 2)))"
hence "(a*d - b*c)*(a*d - b*c) = 0"
by (auto simp add: field_simps)
hence *: "a*d - b*c = 0"
by auto
assume "a*d ≠ b*c"
with * show False
by auto
qed
lemma mat_det_inv:
assumes "mat_det A ≠ 0"
shows "mat_det (mat_inv A) = 1 / mat_det A"
proof-
have "mat_det eye = mat_det A * mat_det (mat_inv A)"
using mat_inv_l[OF assms, symmetric]
by simp
thus ?thesis
using assms
by (simp add: field_simps)
qed
lemma mult_mm_inv_l:
assumes "mat_det A ≠ 0" and "A *⇩m⇩m B = C"
shows "B = mat_inv A *⇩m⇩m C"
using assms mat_eye_l[of B]
by (auto simp add: mult_mm_assoc mat_inv_l)
lemma mult_mm_inv_r:
assumes "mat_det B ≠ 0" and "A *⇩m⇩m B = C"
shows "A = C *⇩m⇩m mat_inv B"
using assms mat_eye_r[of A]
by (auto simp add: mult_mm_assoc[symmetric] mat_inv_r)
lemma mult_mm_non_zero_l:
assumes "mat_det A ≠ 0" and "B ≠ mat_zero"
shows "A *⇩m⇩m B ≠ mat_zero"
using assms mat_zero_r
using mult_mm_inv_l[OF assms(1), of B mat_zero]
by auto
lemma mat_inv_mult_mm:
assumes "mat_det A ≠ 0" and "mat_det B ≠ 0"
shows "mat_inv (A *⇩m⇩m B) = mat_inv B *⇩m⇩m mat_inv A"
using assms
proof-
have "(A *⇩m⇩m B) *⇩m⇩m (mat_inv B *⇩m⇩m mat_inv A) = eye"
using assms
by (metis mat_inv_r mult_mm_assoc mult_mm_inv_r)
thus ?thesis
using mult_mm_inv_l[of "A *⇩m⇩m B" "mat_inv B *⇩m⇩m mat_inv A" eye] assms mat_eye_r
by simp
qed
lemma mult_mm_cancel_l:
assumes "mat_det M ≠ 0" "M *⇩m⇩m A = M *⇩m⇩m B"
shows "A = B"
using assms
by (metis mult_mm_inv_l)
lemma mult_mm_cancel_r:
assumes "mat_det M ≠ 0" "A *⇩m⇩m M = B *⇩m⇩m M"
shows "A = B"
using assms
by (metis mult_mm_inv_r)
lemma mult_mm_non_zero_r:
assumes "A ≠ mat_zero" and "mat_det B ≠ 0"
shows "A *⇩m⇩m B ≠ mat_zero"
using assms mat_zero_l
using mult_mm_inv_r[OF assms(2), of A mat_zero]
by auto
lemma mat_inv_mult_sm:
assumes "k ≠ 0"
shows "mat_inv (k *⇩s⇩m A) = (1 / k) *⇩s⇩m mat_inv A"
proof-
obtain a b c d where "A = (a, b, c, d)"
by (cases A) auto
thus ?thesis
using assms
by auto (subst mult.assoc[of k a "k*d"], subst mult.assoc[of k b "k*c"], subst right_diff_distrib[of k "a*(k*d)" "b*(k*c)", symmetric], simp, simp add: field_simps)+
qed
lemma mat_inv_inv [simp]:
assumes "mat_det M ≠ 0"
shows "mat_inv (mat_inv M) = M"
proof-
have "mat_inv M *⇩m⇩m M = eye"
using mat_inv_l[OF assms]
by simp
thus ?thesis
using assms mat_det_inv[of M]
using mult_mm_inv_l[of "mat_inv M" M eye] mat_eye_r
by (auto simp del: eye_def)
qed
text ‹Matrix transpose›
fun mat_transpose where
"mat_transpose (a, b, c, d) = (a, c, b, d)"
lemma mat_t_mat_t [simp]:
shows "mat_transpose (mat_transpose A) = A"
by (cases A) auto
lemma mat_t_mult_sm [simp]:
shows "mat_transpose (k *⇩s⇩m A) = k *⇩s⇩m (mat_transpose A)"
by (cases A) simp
lemma mat_t_mult_mm [simp]:
shows "mat_transpose (A *⇩m⇩m B) = mat_transpose B *⇩m⇩m mat_transpose A"
by (cases A, cases B) auto
lemma mat_inv_transpose:
shows "mat_transpose (mat_inv M) = mat_inv (mat_transpose M)"
by (cases M) auto
lemma mat_det_transpose [simp]:
fixes M :: "complex_mat"
shows "mat_det (mat_transpose M) = mat_det M"
by (cases M) auto
text ‹Diagonal matrices definition›
fun mat_diagonal where
"mat_diagonal (A, B, C, D) = (B = 0 ∧ C = 0)"
text ‹Matrix conjugate›
fun mat_map where
"mat_map f (a, b, c, d) = (f a, f b, f c, f d)"
definition mat_cnj where
"mat_cnj = mat_map cnj"
lemma mat_cnj_cnj [simp]:
shows "mat_cnj (mat_cnj A) = A"
unfolding mat_cnj_def
by (cases A) auto
lemma mat_cnj_sm [simp]:
shows "mat_cnj (k *⇩s⇩m A) = cnj k *⇩s⇩m (mat_cnj A)"
by (cases A) (simp add: mat_cnj_def)
lemma mat_det_cnj [simp]:
shows "mat_det (mat_cnj A) = cnj (mat_det A)"
by (cases A) (simp add: mat_cnj_def)
lemma nonzero_mat_cnj:
shows "mat_cnj A = mat_zero ⟷ A = mat_zero"
by (cases A) (auto simp add: mat_cnj_def)
lemma mat_inv_cnj:
shows "mat_cnj (mat_inv M) = mat_inv (mat_cnj M)"
unfolding mat_cnj_def
by (cases M) auto
text ‹Matrix adjoint - the conjugate traspose matrix ($A^* = \overline{A^t}$)›
definition mat_adj where
"mat_adj A = mat_cnj (mat_transpose A)"
lemma mat_adj_mult_mm [simp]:
shows "mat_adj (A *⇩m⇩m B) = mat_adj B *⇩m⇩m mat_adj A"
by (cases A, cases B) (auto simp add: mat_adj_def mat_cnj_def)
lemma mat_adj_mult_sm [simp]:
shows "mat_adj (k *⇩s⇩m A) = cnj k *⇩s⇩m mat_adj A"
by (cases A) (auto simp add: mat_adj_def mat_cnj_def)
lemma mat_det_adj:
shows "mat_det (mat_adj A) = cnj (mat_det A)"
by (cases A) (auto simp add: mat_adj_def mat_cnj_def)
lemma mat_adj_inv:
assumes "mat_det M ≠ 0"
shows "mat_adj (mat_inv M) = mat_inv (mat_adj M)"
by (cases M) (auto simp add: mat_adj_def mat_cnj_def)
lemma mat_transpose_mat_cnj:
shows "mat_transpose (mat_cnj A) = mat_adj A"
by (cases A) (auto simp add: mat_adj_def mat_cnj_def)
lemma mat_adj_adj [simp]:
shows "mat_adj (mat_adj A) = A"
unfolding mat_adj_def
by (subst mat_transpose_mat_cnj) (simp add: mat_adj_def)
lemma mat_adj_eye [simp]:
shows "mat_adj eye = eye"
by (auto simp add: mat_adj_def mat_cnj_def)
text ‹Matrix trace›
fun mat_trace where
"mat_trace (a, b, c, d) = a + d"
text ‹Multiplication of matrix and a vector›
fun mult_mv :: "complex_mat ⇒ complex_vec ⇒ complex_vec" (infixl "*⇩m⇩v" 100) where
"(a, b, c, d) *⇩m⇩v (x, y) = (x*a + y*b, x*c + y*d)"
fun mult_vm :: "complex_vec ⇒ complex_mat ⇒ complex_vec" (infixl "*⇩v⇩m" 100) where
"(x, y) *⇩v⇩m (a, b, c, d) = (x*a + y*c, x*b + y*d)"
lemma eye_mv_l [simp]:
shows "eye *⇩m⇩v v = v"
by (cases v) simp
lemma mult_mv_mv [simp]:
shows "B *⇩m⇩v (A *⇩m⇩v v) = (B *⇩m⇩m A) *⇩m⇩v v"
by (cases v, cases A, cases B) (auto simp add: field_simps)
lemma mult_vm_vm [simp]:
shows "(v *⇩v⇩m A) *⇩v⇩m B = v *⇩v⇩m (A *⇩m⇩m B)"
by (cases v, cases A, cases B) (auto simp add: field_simps)
lemma mult_mv_inv:
assumes "x = A *⇩m⇩v y" and "mat_det A ≠ 0"
shows "y = (mat_inv A) *⇩m⇩v x"
using assms
by (cases y) (simp add: mat_inv_l)
lemma mult_vm_inv:
assumes "x = y *⇩v⇩m A" and "mat_det A ≠ 0"
shows "y = x *⇩v⇩m (mat_inv A) "
using assms
by (cases y) (simp add: mat_inv_r)
lemma mult_mv_cancel_l:
assumes "mat_det A ≠ 0" and "A *⇩m⇩v v = A *⇩m⇩v v'"
shows "v = v'"
using assms
using mult_mv_inv
by blast
lemma mult_vm_cancel_r:
assumes "mat_det A ≠ 0" and "v *⇩v⇩m A = v' *⇩v⇩m A"
shows "v = v'"
using assms
using mult_vm_inv
by blast
lemma vec_zero_l [simp]:
shows "A *⇩m⇩v vec_zero = vec_zero"
by (cases A) simp
lemma vec_zero_r [simp]:
shows "vec_zero *⇩v⇩m A = vec_zero"
by (cases A) simp
lemma mult_mv_nonzero:
assumes "v ≠ vec_zero" and "mat_det A ≠ 0"
shows "A *⇩m⇩v v ≠ vec_zero"
apply (rule ccontr)
using assms mult_mv_inv[of vec_zero A v] mat_inv_l vec_zero_l
by auto
lemma mult_vm_nonzero:
assumes "v ≠ vec_zero" and "mat_det A ≠ 0"
shows "v *⇩v⇩m A ≠ vec_zero"
apply (rule ccontr)
using assms mult_vm_inv[of vec_zero v A] mat_inv_r vec_zero_r
by auto
lemma mult_sv_mv:
shows "k *⇩s⇩v (A *⇩m⇩v v) = (A *⇩m⇩v (k *⇩s⇩v v))"
by (cases A, cases v) (simp add: field_simps)
lemma mult_mv_mult_vm:
shows "A *⇩m⇩v x = x *⇩v⇩m (mat_transpose A)"
by (cases A, cases x) auto
lemma mult_mv_vv:
shows "A *⇩m⇩v v1 *⇩v⇩v v2 = v1 *⇩v⇩v (mat_transpose A *⇩m⇩v v2)"
by (cases v1, cases v2, cases A) (auto simp add: field_simps)
lemma mult_vv_mv:
shows "x *⇩v⇩v (A *⇩m⇩v y) = (x *⇩v⇩m A) *⇩v⇩v y"
by (cases x, cases y, cases A) (auto simp add: field_simps)
lemma vec_cnj_mult_mv:
shows "vec_cnj (A *⇩m⇩v x) = (mat_cnj A) *⇩m⇩v (vec_cnj x)"
by (cases A, cases x) (auto simp add: vec_cnj_def mat_cnj_def)
lemma vec_cnj_mult_vm:
shows "vec_cnj (v *⇩v⇩m A) = vec_cnj v *⇩v⇩m mat_cnj A"
unfolding vec_cnj_def mat_cnj_def
by (cases A, cases v, auto)
subsubsection ‹Eigenvalues and eigenvectors›
definition eigenpair where
[simp]: "eigenpair k v H ⟷ v ≠ vec_zero ∧ H *⇩m⇩v v = k *⇩s⇩v v"
definition eigenval where
[simp]: "eigenval k H ⟷ (∃ v. v ≠ vec_zero ∧ H *⇩m⇩v v = k *⇩s⇩v v)"
lemma eigen_equation:
shows "eigenval k H ⟷ k⇧2 - mat_trace H * k + mat_det H = 0" (is "?lhs ⟷ ?rhs")
proof-
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
show ?thesis
proof
assume ?lhs
then obtain v where "v ≠ vec_zero" "H *⇩m⇩v v = k *⇩s⇩v v"
unfolding eigenval_def
by blast
obtain v1 v2 where vv: "v = (v1, v2)"
by (cases v) auto
from ‹H *⇩m⇩v v = k *⇩s⇩v v› have "(H -⇩m⇩m (k *⇩s⇩m eye)) *⇩m⇩v v = vec_zero"
using HH vv
by (auto simp add: field_simps)
hence "mat_det (H -⇩m⇩m (k *⇩s⇩m eye)) = 0"
using ‹v ≠ vec_zero› vv HH
using regular_homogenous_system[of "A - k" B C "D - k" v1 v2]
unfolding det2_def
by (auto simp add: field_simps)
thus ?rhs
using HH
by (auto simp add: power2_eq_square field_simps)
next
assume ?rhs
hence *: "mat_det (H -⇩m⇩m (k *⇩s⇩m eye)) = 0"
using HH
by (auto simp add: field_simps power2_eq_square)
show ?lhs
proof (cases "H -⇩m⇩m (k *⇩s⇩m eye) = mat_zero")
case True
thus ?thesis
using HH
by (auto) (rule_tac x=1 in exI, simp)
next
case False
hence "(A - k ≠ 0 ∨ B ≠ 0) ∨ (D - k ≠ 0 ∨ C ≠ 0)"
using HH
by auto
thus ?thesis
proof
assume "A - k ≠ 0 ∨ B ≠ 0"
hence "C * B + (D - k) * (k - A) = 0"
using * singular_system[of "A-k" "D-k" B C "(0, 0)" 0 0 "(B, k-A)"] HH
by (auto simp add: field_simps)
hence "(B, k-A) ≠ vec_zero" "(H -⇩m⇩m (k *⇩s⇩m eye)) *⇩m⇩v (B, k-A) = vec_zero"
using HH ‹A - k ≠ 0 ∨ B ≠ 0›
by (auto simp add: field_simps)
then obtain v where "v ≠ vec_zero ∧ (H -⇩m⇩m (k *⇩s⇩m eye)) *⇩m⇩v v = vec_zero"
by blast
thus ?thesis
using HH
unfolding eigenval_def
by (rule_tac x="v" in exI) (case_tac v, simp add: field_simps)
next
assume "D - k ≠ 0 ∨ C ≠ 0"
hence "C * B + (D - k) * (k - A) = 0"
using * singular_system[of "D-k" "A-k" C B "(0, 0)" 0 0 "(C, k-D)"] HH
by (auto simp add: field_simps)
hence "(k-D, C) ≠ vec_zero" "(H -⇩m⇩m (k *⇩s⇩m eye)) *⇩m⇩v (k-D, C) = vec_zero"
using HH ‹D - k ≠ 0 ∨ C ≠ 0›
by (auto simp add: field_simps)
then obtain v where "v ≠ vec_zero ∧ (H -⇩m⇩m (k *⇩s⇩m eye)) *⇩m⇩v v = vec_zero"
by blast
thus ?thesis
using HH
unfolding eigenval_def
by (rule_tac x="v" in exI) (case_tac v, simp add: field_simps)
qed
qed
qed
qed
subsubsection ‹Bilinear and Quadratic forms, Congruence, and Similarity›
text ‹Bilinear forms›
definition bilinear_form where
[simp]: "bilinear_form v1 v2 H = (vec_cnj v1) *⇩v⇩m H *⇩v⇩v v2"
lemma bilinear_form_scale_m:
shows "bilinear_form v1 v2 (k *⇩s⇩m H) = k * bilinear_form v1 v2 H"
by (cases v1, cases v2, cases H) (simp add: vec_cnj_def field_simps)
lemma bilinear_form_scale_v1:
shows "bilinear_form (k *⇩s⇩v v1) v2 H = cnj k * bilinear_form v1 v2 H"
by (cases v1, cases v2, cases H) (simp add: vec_cnj_def field_simps)
lemma bilinear_form_scale_v2:
shows "bilinear_form v1 (k *⇩s⇩v v2) H = k * bilinear_form v1 v2 H"
by (cases v1, cases v2, cases H) (simp add: vec_cnj_def field_simps)
text ‹Quadratic forms›
definition quad_form where
[simp]: "quad_form v H = (vec_cnj v) *⇩v⇩m H *⇩v⇩v v"
lemma quad_form_bilinear_form:
shows "quad_form v H = bilinear_form v v H"
by simp
lemma quad_form_scale_v:
shows "quad_form (k *⇩s⇩v v) H = cor ((cmod k)⇧2) * quad_form v H"
using bilinear_form_scale_v1 bilinear_form_scale_v2
by (simp add: complex_mult_cnj_cmod field_simps)
lemma quad_form_scale_m:
shows "quad_form v (k *⇩s⇩m H) = k * quad_form v H"
using bilinear_form_scale_m
by simp
lemma cnj_quad_form [simp]:
shows "cnj (quad_form z H) = quad_form z (mat_adj H)"
by (cases H, cases z) (auto simp add: mat_adj_def mat_cnj_def vec_cnj_def field_simps)
text ‹Matrix congruence›
text ‹Two matrices are congruent iff they represent the same quadratic form with respect to different
bases (for example if one circline can be transformed to another by a Möbius trasformation).›
definition congruence where
[simp]: "congruence M H ≡ mat_adj M *⇩m⇩m H *⇩m⇩m M"
lemma congruence_nonzero:
assumes "H ≠ mat_zero" and "mat_det M ≠ 0"
shows "congruence M H ≠ mat_zero"
using assms
unfolding congruence_def
by (subst mult_mm_non_zero_r, subst mult_mm_non_zero_l) (auto simp add: mat_det_adj)
lemma congruence_congruence:
shows "congruence M1 (congruence M2 H) = congruence (M2 *⇩m⇩m M1) H"
unfolding congruence_def
apply (subst mult_mm_assoc)
apply (subst mult_mm_assoc)
apply (subst mat_adj_mult_mm)
apply (subst mult_mm_assoc)
by simp
lemma congruence_eye [simp]:
shows "congruence eye H = H"
by (cases H) (simp add: mat_adj_def mat_cnj_def)
lemma congruence_congruence_inv [simp]:
assumes "mat_det M ≠ 0"
shows "congruence M (congruence (mat_inv M) H) = H"
using assms congruence_congruence[of M "mat_inv M" H]
using mat_inv_l[of M] mat_eye_l mat_eye_r
unfolding congruence_def
by (simp del: eye_def)
lemma congruence_inv:
assumes "mat_det M ≠ 0" and "congruence M H = H'"
shows "congruence (mat_inv M) H' = H"
using assms
using ‹mat_det M ≠ 0› mult_mm_inv_l[of "mat_adj M" "H *⇩m⇩m M" "H'"]
using mult_mm_inv_r[of M "H" "mat_inv (mat_adj M) *⇩m⇩m H'"]
by (simp add: mat_det_adj mult_mm_assoc mat_adj_inv)
lemma congruence_scale_m [simp]:
shows "congruence M (k *⇩s⇩m H) = k *⇩s⇩m (congruence M H)"
by (cases M, cases H) (auto simp add: mat_adj_def mat_cnj_def field_simps)
lemma inj_congruence:
assumes "mat_det M ≠ 0" and "congruence M H = congruence M H'"
shows "H = H'"
proof-
have "H *⇩m⇩m M = H' *⇩m⇩m M "
using assms
using mult_mm_cancel_l[of "mat_adj M" "H *⇩m⇩m M" "H' *⇩m⇩m M"]
by (simp add: mat_det_adj mult_mm_assoc)
thus ?thesis
using assms
using mult_mm_cancel_r[of "M" "H" "H'"]
by simp
qed
lemma mat_det_congruence [simp]:
"mat_det (congruence M H) = (cor ((cmod (mat_det M))⇧2)) * mat_det H"
using complex_mult_cnj_cmod[of "mat_det M"]
by (auto simp add: mat_det_adj field_simps)
lemma det_sgn_congruence [simp]:
assumes "mat_det M ≠ 0"
shows "sgn (mat_det (congruence M H)) = sgn (mat_det H)"
using assms
by (subst mat_det_congruence, auto simp add: sgn_mult power2_eq_square) (simp add: sgn_of_real)
lemma Re_det_sgn_congruence [simp]:
assumes "mat_det M ≠ 0"
shows "sgn (Re (mat_det (congruence M H))) = sgn (Re (mat_det H))"
proof-
have *: "Re (mat_det (congruence M H)) = (cmod (mat_det M))⇧2 * Re (mat_det H)"
by (subst mat_det_congruence, subst Re_mult_real, rule Im_complex_of_real) (subst Re_complex_of_real, simp)
show ?thesis
using assms
by (subst *) (auto simp add: sgn_mult)
qed
text ‹Transforming a matrix $H$ by a regular matrix $M$ preserves its bilinear and quadratic forms.›
lemma bilinear_form_congruence [simp]:
assumes "mat_det M ≠ 0"
shows "bilinear_form (M *⇩m⇩v v1) (M *⇩m⇩v v2) (congruence (mat_inv M) H) =
bilinear_form v1 v2 H"
proof-
have "mat_det (mat_adj M) ≠ 0"
using assms
by (simp add: mat_det_adj)
show ?thesis
unfolding bilinear_form_def congruence_def
apply (subst mult_mv_mult_vm)
apply (subst vec_cnj_mult_vm)
apply (subst mat_adj_def[symmetric])
apply (subst mult_vm_vm)
apply (subst mult_vv_mv)
apply (subst mult_vm_vm)
apply (subst mat_adj_inv[OF ‹mat_det M ≠ 0›])
apply (subst mult_assoc_5)
apply (subst mat_inv_r[OF ‹mat_det (mat_adj M) ≠ 0›])
apply (subst mat_inv_l[OF ‹mat_det M ≠ 0›])
apply (subst mat_eye_l, subst mat_eye_r)
by simp
qed
lemma quad_form_congruence [simp]:
assumes "mat_det M ≠ 0"
shows "quad_form (M *⇩m⇩v z) (congruence (mat_inv M) H) = quad_form z H"
using bilinear_form_congruence[OF assms]
by simp
text ‹Similar matrices›
text ‹Two matrices are similar iff they represent the same linear operator with respect to (possibly)
different bases (e.g., if they represent the same Möbius transformation after changing the
coordinate system)›
definition similarity where
"similarity A M = mat_inv A *⇩m⇩m M *⇩m⇩m A"
lemma mat_det_similarity [simp]:
assumes "mat_det A ≠ 0"
shows "mat_det (similarity A M) = mat_det M"
using assms
unfolding similarity_def
by (simp add: mat_det_inv)
lemma mat_trace_similarity [simp]:
assumes "mat_det A ≠ 0"
shows "mat_trace (similarity A M) = mat_trace M"
proof-
obtain a b c d where AA: "A = (a, b, c, d)"
by (cases A) auto
obtain mA mB mC mD where MM: "M = (mA, mB, mC, mD)"
by (cases M) auto
have "mA * (a * d) / (a * d - b * c) + mD * (a * d) / (a * d - b * c) =
mA + mD + mA * (b * c) / (a * d - b * c) + mD * (b * c) / (a * d - b * c)"
using assms AA
by (simp add: field_simps)
thus ?thesis
using AA MM
by (simp add: field_simps similarity_def)
qed
lemma similarity_eye [simp]:
shows "similarity eye M = M"
unfolding similarity_def
using mat_eye_l mat_eye_r
by auto
lemma similarity_eye' [simp]:
shows "similarity (1, 0, 0, 1) M = M"
unfolding eye_def[symmetric]
by (simp del: eye_def)
lemma similarity_comp [simp]:
assumes "mat_det A1 ≠ 0" and "mat_det A2 ≠ 0"
shows "similarity A1 (similarity A2 M) = similarity (A2*⇩m⇩mA1) M"
using assms
unfolding similarity_def
by (simp add: mult_mm_assoc mat_inv_mult_mm)
lemma similarity_inv:
assumes "similarity A M1 = M2" and "mat_det A ≠ 0"
shows "similarity (mat_inv A) M2 = M1"
using assms
unfolding similarity_def
by (metis mat_det_mult mult_mm_assoc mult_mm_inv_l mult_mm_inv_r mult_zero_left)
end
Theory Unitary_Matrices
subsection ‹Generalized Unitary Matrices›
theory Unitary_Matrices
imports Matrices More_Complex
begin
text ‹In this section (generalized) $2\times 2$ unitary matrices are introduced.›
text ‹Unitary matrices›
definition unitary where
"unitary M ⟷ mat_adj M *⇩m⇩m M = eye"
text ‹Generalized unitary matrices›
definition unitary_gen where
"unitary_gen M ⟷
(∃ k::complex. k ≠ 0 ∧ mat_adj M *⇩m⇩m M = k *⇩s⇩m eye)"
text ‹Scalar can be always be a positive real›
lemma unitary_gen_real:
assumes "unitary_gen M"
shows "(∃ k::real. k > 0 ∧ mat_adj M *⇩m⇩m M = cor k *⇩s⇩m eye)"
proof-
obtain k where *: "mat_adj M *⇩m⇩m M = k *⇩s⇩m eye" "k ≠ 0"
using assms
by (auto simp add: unitary_gen_def)
obtain a b c d where "M = (a, b, c, d)"
by (cases M) auto
hence "k = cor ((cmod a)⇧2) + cor ((cmod c)⇧2)"
using *
by (subst complex_mult_cnj_cmod[symmetric])+ (auto simp add: mat_adj_def mat_cnj_def)
hence "is_real k ∧ Re k > 0"
using ‹k ≠ 0›
by (smt add_cancel_left_left arg_0_iff arg_complex_of_real_positive not_sum_power2_lt_zero of_real_0 plus_complex.simps(1) plus_complex.simps(2))
thus ?thesis
using *
by (rule_tac x="Re k" in exI) simp
qed
text ‹Generalized unitary matrices can be factored into a product of a unitary matrix and a real
positive scalar multiple of the identity matrix›
lemma unitary_gen_unitary:
shows "unitary_gen M ⟷
(∃ k M'. k > 0 ∧ unitary M' ∧ M = (cor k *⇩s⇩m eye) *⇩m⇩m M')" (is "?lhs = ?rhs")
proof
assume ?lhs
then obtain k where *: "k>0" "mat_adj M *⇩m⇩m M = cor k *⇩s⇩m eye"
using unitary_gen_real[of M]
by auto
let ?k' = "cor (sqrt k)"
have "?k' * cnj ?k' = cor k"
using ‹k > 0›
by simp
moreover
have "Re ?k' > 0" "is_real ?k'" "?k' ≠ 0"
using ‹k > 0›
by auto
ultimately
show ?rhs
using * mat_eye_l
unfolding unitary_gen_def unitary_def
by (rule_tac x="Re ?k'" in exI) (rule_tac x="(1/?k')*⇩s⇩mM" in exI, simp add: mult_sm_mm[symmetric])
next
assume ?rhs
then obtain k M' where "k > 0" "unitary M'" "M = (cor k *⇩s⇩m eye) *⇩m⇩m M'"
by blast
hence "M = cor k *⇩s⇩m M'"
using mult_sm_mm[of "cor k" eye M'] mat_eye_l
by simp
thus ?lhs
using ‹unitary M'› ‹k > 0›
by (simp add: unitary_gen_def unitary_def)
qed
text ‹When they represent Möbius transformations, eneralized unitary matrices fix the imaginary unit circle. Therefore, they
fix a Hermitean form with (2, 0) signature (two positive and no negative diagonal elements).›
lemma unitary_gen_iff':
shows "unitary_gen M ⟷
(∃ k::complex. k ≠ 0 ∧ congruence M (1, 0, 0, 1) = k *⇩s⇩m (1, 0, 0, 1))"
unfolding unitary_gen_def
using mat_eye_r
by (auto simp add: mult.assoc)
text ‹Unitary matrices are special cases of general unitary matrices›
lemma unitary_unitary_gen [simp]:
assumes "unitary M"
shows "unitary_gen M"
using assms
unfolding unitary_gen_def unitary_def
by auto
text ‹Generalized unitary matrices are regular›
lemma unitary_gen_regular:
assumes "unitary_gen M"
shows "mat_det M ≠ 0"
proof-
from assms obtain k where
"k ≠ 0" "mat_adj M *⇩m⇩m M = k *⇩s⇩m eye"
unfolding unitary_gen_def
by auto
hence "mat_det (mat_adj M *⇩m⇩m M) ≠ 0"
by simp
thus ?thesis
by (simp add: mat_det_adj)
qed
lemmas unitary_regular = unitary_gen_regular[OF unitary_unitary_gen]
subsubsection ‹Group properties›
text ‹Generalized $2\times 2$ unitary matrices form a group under
multiplication (usually denoted by $GU(2, \mathbb{C})$). The group is closed
under non-zero complex scalar multiplication. Since these matrices are
always regular, they form a subgroup of general linear group (usually
denoted by $GL(2, \mathbb{C})$) of all regular matrices.›
lemma unitary_gen_scale [simp]:
assumes "unitary_gen M" and "k ≠ 0"
shows "unitary_gen (k *⇩s⇩m M)"
using assms
unfolding unitary_gen_def
by auto
lemma unitary_comp:
assumes "unitary M1" and "unitary M2"
shows "unitary (M1 *⇩m⇩m M2)"
using assms
unfolding unitary_def
by (metis mat_adj_mult_mm mat_eye_l mult_mm_assoc)
lemma unitary_gen_comp:
assumes "unitary_gen M1" and "unitary_gen M2"
shows "unitary_gen (M1 *⇩m⇩m M2)"
proof-
obtain k1 k2 where *: "k1 * k2 ≠ 0" "mat_adj M1 *⇩m⇩m M1 = k1 *⇩s⇩m eye" "mat_adj M2 *⇩m⇩m M2 = k2 *⇩s⇩m eye"
using assms
unfolding unitary_gen_def
by auto
have "mat_adj M2 *⇩m⇩m mat_adj M1 *⇩m⇩m (M1 *⇩m⇩m M2) = mat_adj M2 *⇩m⇩m (mat_adj M1 *⇩m⇩m M1) *⇩m⇩m M2"
by (auto simp add: mult_mm_assoc)
also have "... = mat_adj M2 *⇩m⇩m ((k1 *⇩s⇩m eye) *⇩m⇩m M2)"
using *
by (auto simp add: mult_mm_assoc)
also have "... = mat_adj M2 *⇩m⇩m (k1 *⇩s⇩m M2)"
using mult_sm_eye_mm[of k1 M2]
by (simp del: eye_def)
also have "... = k1 *⇩s⇩m (k2 *⇩s⇩m eye)"
using *
by auto
finally
show ?thesis
using *
unfolding unitary_gen_def
by (rule_tac x="k1*k2" in exI, simp del: eye_def)
qed
lemma unitary_adj_eq_inv:
shows "unitary M ⟷ mat_det M ≠ 0 ∧ mat_adj M = mat_inv M"
using unitary_regular[of M] mult_mm_inv_r[of M "mat_adj M" eye] mat_eye_l[of "mat_inv M"] mat_inv_l[of M]
unfolding unitary_def
by - (rule, simp_all)
lemma unitary_inv:
assumes "unitary M"
shows "unitary (mat_inv M)"
using assms
unfolding unitary_adj_eq_inv
using mat_adj_inv[of M] mat_det_inv[of M]
by simp
lemma unitary_gen_inv:
assumes "unitary_gen M"
shows "unitary_gen (mat_inv M)"
proof-
obtain k M' where "0 < k" "unitary M'" "M = cor k *⇩s⇩m eye *⇩m⇩m M'"
using unitary_gen_unitary[of M] assms
by blast
hence "mat_inv M = cor (1/k) *⇩s⇩m mat_inv M'"
by (metis mat_inv_mult_sm mult_sm_eye_mm norm_not_less_zero of_real_1 of_real_divide of_real_eq_0_iff sgn_1_neg sgn_greater sgn_if sgn_pos sgn_sgn)
thus ?thesis
using ‹k > 0› ‹unitary M'›
by (subst unitary_gen_unitary[of "mat_inv M"]) (rule_tac x="1/k" in exI, rule_tac x="mat_inv M'" in exI, metis divide_pos_pos mult_sm_eye_mm unitary_inv zero_less_one)
qed
subsubsection ‹The characterization in terms of matrix elements›
text ‹Special matrices are those having the determinant equal to 1. We first give their characterization.›
lemma unitary_special:
assumes "unitary M" and "mat_det M = 1"
shows "∃ a b. M = (a, b, -cnj b, cnj a)"
proof-
have "mat_adj M = mat_inv M"
using assms mult_mm_inv_r[of M "mat_adj M" "eye"] mat_eye_r mat_eye_l
by (simp add: unitary_def)
thus ?thesis
using ‹mat_det M = 1›
by (cases M) (auto simp add: mat_adj_def mat_cnj_def)
qed
lemma unitary_gen_special:
assumes "unitary_gen M" and "mat_det M = 1"
shows "∃ a b. M = (a, b, -cnj b, cnj a)"
proof-
from assms
obtain k where *: "k ≠ 0" "mat_adj M *⇩m⇩m M = k *⇩s⇩m eye"
unfolding unitary_gen_def
by auto
hence "mat_det (mat_adj M *⇩m⇩m M) = k*k"
by simp
hence "k*k = 1"
using assms(2)
by (simp add: mat_det_adj)
hence "k = 1 ∨ k = -1"
using square_eq_1_iff[of k]
by simp
moreover
have "mat_adj M = k *⇩s⇩m mat_inv M"
using *
using assms mult_mm_inv_r[of M "mat_adj M" "k *⇩s⇩m eye"] mat_eye_r mat_eye_l
by simp (metis mult_sm_eye_mm *(2))
moreover
obtain a b c d where "M = (a, b, c, d)"
by (cases M) auto
ultimately
have "M = (a, b, -cnj b, cnj a) ∨ M = (a, b, cnj b, -cnj a)"
using assms(2)
by (auto simp add: mat_adj_def mat_cnj_def)
moreover
have "Re (- (cor (cmod a))⇧2 - (cor (cmod b))⇧2) < 1"
by (smt cmod_square complex_norm_square minus_complex.simps(1) of_real_power realpow_square_minus_le uminus_complex.simps(1))
hence "- (cor (cmod a))⇧2 - (cor (cmod b))⇧2 ≠ 1"
by force
hence "M ≠ (a, b, cnj b, -cnj a)"
using ‹mat_det M = 1› complex_mult_cnj_cmod[of a] complex_mult_cnj_cmod[of b]
by auto
ultimately
show ?thesis
by auto
qed
text ‹A characterization of all generalized unitary matrices›
lemma unitary_gen_iff:
shows "unitary_gen M ⟷
(∃ a b k. k ≠ 0 ∧ mat_det (a, b, -cnj b, cnj a) ≠ 0 ∧
M = k *⇩s⇩m (a, b, -cnj b, cnj a))" (is "?lhs = ?rhs")
proof
assume ?lhs
obtain d where *: "d*d = mat_det M"
using ex_complex_sqrt
by auto
hence "d ≠ 0"
using unitary_gen_regular[OF ‹unitary_gen M›]
by auto
from ‹unitary_gen M›
obtain k where "k ≠ 0" "mat_adj M *⇩m⇩m M = k *⇩s⇩m eye"
unfolding unitary_gen_def
by auto
hence "mat_adj ((1/d)*⇩s⇩mM) *⇩m⇩m ((1/d)*⇩s⇩mM) = (k / (d*cnj d)) *⇩s⇩m eye"
by simp
obtain a b where "(a, b, - cnj b, cnj a) = (1 / d) *⇩s⇩m M"
using unitary_gen_special[of "(1 / d) *⇩s⇩m M"] ‹unitary_gen M› * unitary_gen_regular[of M] ‹d ≠ 0›
by force
moreover
hence "mat_det (a, b, - cnj b, cnj a) ≠ 0"
using unitary_gen_regular[OF ‹unitary_gen M›] ‹d ≠ 0›
by auto
ultimately
show ?rhs
apply (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="d" in exI)
using mult_sm_inv_l[of "1/d" M]
by (auto simp add: field_simps)
next
assume ?rhs
then obtain a b k where "k ≠ 0 ∧ mat_det (a, b, - cnj b, cnj a) ≠ 0 ∧ M = k *⇩s⇩m (a, b, - cnj b, cnj a)"
by auto
thus ?lhs
unfolding unitary_gen_def
apply (auto simp add: mat_adj_def mat_cnj_def)
using mult_eq_0_iff[of "cnj k * k" "cnj a * a + cnj b * b"]
by (auto simp add: field_simps)
qed
text ‹A characterization of unitary matrices›
lemma unitary_iff:
shows "unitary M ⟷
(∃ a b k. (cmod a)⇧2 + (cmod b)⇧2 ≠ 0 ∧
(cmod k)⇧2 = 1 / ((cmod a)⇧2 + (cmod b)⇧2) ∧
M = k *⇩s⇩m (a, b, -cnj b, cnj a))" (is "?lhs = ?rhs")
proof
assume ?lhs
obtain k a b where *: "M = k *⇩s⇩m (a, b, -cnj b, cnj a)" "k ≠ 0" "mat_det (a, b, -cnj b, cnj a) ≠ 0"
using unitary_gen_iff unitary_unitary_gen[OF ‹unitary M›]
by auto
have md: "mat_det (a, b, -cnj b, cnj a) = cor ((cmod a)⇧2 + (cmod b)⇧2)"
by (auto simp add: complex_mult_cnj_cmod)
have "k * cnj k * mat_det (a, b, -cnj b, cnj a) = 1"
using ‹unitary M› *
unfolding unitary_def
by (auto simp add: mat_adj_def mat_cnj_def field_simps)
hence "(cmod k)⇧2 * ((cmod a)⇧2 + (cmod b)⇧2) = 1"
by (metis (mono_tags, lifting) complex_norm_square md of_real_1 of_real_eq_iff of_real_mult)
thus ?rhs
using * mat_eye_l
apply (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI)
apply (auto simp add: complex_mult_cnj_cmod)
by (metis ‹(cmod k)⇧2 * ((cmod a)⇧2 + (cmod b)⇧2) = 1› mult_eq_0_iff nonzero_eq_divide_eq zero_neq_one)
next
assume ?rhs
then obtain a b k where *: "(cmod a)⇧2 + (cmod b)⇧2 ≠ 0" "(cmod k)⇧2 = 1 / ((cmod a)⇧2 + (cmod b)⇧2)" "M = k *⇩s⇩m (a, b, -cnj b, cnj a)"
by auto
have "(k * cnj k) * (a * cnj a) + (k * cnj k) * (b * cnj b) = 1"
apply (subst complex_mult_cnj_cmod)+
using *(1-2)
by (metis (no_types, lifting) distrib_left nonzero_eq_divide_eq of_real_1 of_real_add of_real_divide of_real_eq_0_iff)
thus ?lhs
using *
unfolding unitary_def
by (simp add: mat_adj_def mat_cnj_def field_simps)
qed
end
Theory Unitary11_Matrices
subsection ‹Generalized unitary matrices with signature $(1, 1)$›
theory Unitary11_Matrices
imports Matrices More_Complex
begin
text ‹ When acting as Möbius transformations in the extended
complex plane, generalized complex $2\times 2$ unitary matrices fix
the imaginary unit circle (a Hermitean form with (2, 0) signature). We
now describe matrices that fix the ordinary unit circle (a Hermitean
form with (1, 1) signature, i.e., one positive and one negative
element on the diagonal). These are extremely important for further
formalization, since they will represent disc automorphisims and
isometries of the Poincar\'e disc. The development of this theory
follows the development of the theory of generalized unitary matrices.
›
text ‹Unitary11 matrices›
definition unitary11 where
"unitary11 M ⟷ congruence M (1, 0, 0, -1) = (1, 0, 0, -1)"
text ‹Generalized unitary11 matrices›
definition unitary11_gen where
"unitary11_gen M ⟷ (∃ k. k ≠ 0 ∧ congruence M (1, 0, 0, -1) = k *⇩s⇩m (1, 0, 0, -1))"
text ‹Scalar can always be a non-zero real number›
lemma unitary11_gen_real:
shows "unitary11_gen M ⟷ (∃ k. k ≠ 0 ∧ congruence M (1, 0, 0, -1) = cor k *⇩s⇩m (1, 0, 0, -1))"
unfolding unitary11_gen_def
proof (auto simp del: congruence_def)
fix k
assume "k ≠ 0" "congruence M (1, 0, 0, -1) = (k, 0, 0, - k)"
hence "mat_det (congruence M (1, 0, 0, -1)) = -k*k"
by simp
moreover
have "is_real (mat_det (congruence M (1, 0, 0, -1)))" "Re (mat_det (congruence M (1, 0, 0, -1))) ≤ 0"
by (auto simp add: mat_det_adj)
ultimately
have "is_real (k*k)" "Re (-k*k) ≤ 0"
by auto
hence "is_real (k*k) ∧ Re (k * k) > 0"
using ‹k ≠ 0›
by (smt complex_eq_if_Re_eq mult_eq_0_iff mult_minus_left uminus_complex.simps(1) zero_complex.simps(1) zero_complex.simps(2))
hence "is_real k"
by auto
thus "∃ka. ka ≠ 0 ∧ k = cor ka"
using ‹k ≠ 0›
by (rule_tac x="Re k" in exI) (cases k, auto simp add: Complex_eq)
qed
text ‹Unitary11 matrices are special cases of generalized unitary 11 matrices›
lemma unitary11_unitary11_gen [simp]:
assumes "unitary11 M"
shows "unitary11_gen M"
using assms
unfolding unitary11_gen_def unitary11_def
by (rule_tac x="1" in exI, auto)
text ‹All generalized unitary11 matrices are regular›
lemma unitary11_gen_regular:
assumes "unitary11_gen M"
shows "mat_det M ≠ 0"
proof-
from assms obtain k where
"k ≠ 0" "mat_adj M *⇩m⇩m (1, 0, 0, -1) *⇩m⇩m M = cor k *⇩s⇩m (1, 0, 0, -1)"
unfolding unitary11_gen_real
by auto
hence "mat_det (mat_adj M *⇩m⇩m (1, 0, 0, -1) *⇩m⇩m M) ≠ 0"
by simp
thus ?thesis
by (simp add: mat_det_adj)
qed
lemmas unitary11_regular = unitary11_gen_regular[OF unitary11_unitary11_gen]
subsubsection ‹The characterization in terms of matrix elements›
text ‹Special matrices are those having the determinant equal to 1. We first give their characterization.›
lemma unitary11_special:
assumes "unitary11 M" and "mat_det M = 1"
shows "∃ a b. M = (a, b, cnj b, cnj a)"
proof-
have "mat_adj M *⇩m⇩m (1, 0, 0, -1) = (1, 0, 0, -1) *⇩m⇩m mat_inv M"
using assms mult_mm_inv_r
by (simp add: unitary11_def)
thus ?thesis
using assms(2)
by (cases M) (simp add: mat_adj_def mat_cnj_def)
qed
lemma unitary11_gen_special:
assumes "unitary11_gen M" and "mat_det M = 1"
shows "∃ a b. M = (a, b, cnj b, cnj a) ∨ M = (a, b, -cnj b, -cnj a)"
proof-
from assms
obtain k where *: "k ≠ 0" "mat_adj M *⇩m⇩m (1, 0, 0, -1) *⇩m⇩m M = cor k *⇩s⇩m (1, 0, 0, -1)"
unfolding unitary11_gen_real
by auto
hence "mat_det (mat_adj M *⇩m⇩m (1, 0, 0, -1) *⇩m⇩m M) = - cor k* cor k"
by simp
hence "mat_det (mat_adj M *⇩m⇩m M) = cor k* cor k"
by simp
hence "cor k* cor k = 1"
using assms(2)
by (simp add: mat_det_adj)
hence "cor k = 1 ∨ cor k = -1"
using square_eq_1_iff[of "cor k"]
by simp
moreover
have "mat_adj M *⇩m⇩m (1, 0, 0, -1) = (cor k *⇩s⇩m (1, 0, 0, -1)) *⇩m⇩m mat_inv M "
using *
using assms mult_mm_inv_r mat_eye_r mat_eye_l
by auto
moreover
obtain a b c d where "M = (a, b, c, d)"
by (cases M) auto
ultimately
have "M = (a, b, cnj b, cnj a) ∨ M = (a, b, -cnj b, -cnj a)"
using assms(2)
by (auto simp add: mat_adj_def mat_cnj_def)
thus ?thesis
by auto
qed
text ‹A characterization of all generalized unitary11 matrices›
lemma unitary11_gen_iff':
shows "unitary11_gen M ⟷
(∃ a b k. k ≠ 0 ∧ mat_det (a, b, cnj b, cnj a) ≠ 0 ∧
(M = k *⇩s⇩m (a, b, cnj b, cnj a) ∨
M = k *⇩s⇩m (-1, 0, 0, 1) *⇩m⇩m (a, b, cnj b, cnj a)))" (is "?lhs = ?rhs")
proof
assume ?lhs
obtain d where *: "d*d = mat_det M"
using ex_complex_sqrt
by auto
hence "d ≠ 0"
using unitary11_gen_regular[OF ‹unitary11_gen M›]
by auto
from ‹unitary11_gen M›
obtain k where "k ≠ 0" "mat_adj M *⇩m⇩m (1, 0, 0, -1) *⇩m⇩m M = cor k *⇩s⇩m (1, 0, 0, -1)"
unfolding unitary11_gen_real
by auto
hence "mat_adj ((1/d)*⇩s⇩mM)*⇩m⇩m (1, 0, 0, -1) *⇩m⇩m ((1/d)*⇩s⇩mM) = (cor k / (d*cnj d)) *⇩s⇩m (1, 0, 0, -1)"
by simp
moreover
have "is_real (cor k / (d * cnj d))"
by (metis complex_In_mult_cnj_zero div_reals Im_complex_of_real)
hence "cor (Re (cor k / (d * cnj d))) = cor k / (d * cnj d)"
by simp
ultimately
have "unitary11_gen ((1/d)*⇩s⇩mM)"
unfolding unitary11_gen_real
using ‹d ≠ 0› ‹k ≠ 0›
using ‹cor (Re (cor k / (d * cnj d))) = cor k / (d * cnj d)›
by (rule_tac x="Re (cor k / (d * cnj d))" in exI, auto, simp add: *)
moreover
have "mat_det ((1 / d) *⇩s⇩m M) = 1"
using * unitary11_gen_regular[of M] ‹unitary11_gen M›
by auto
ultimately
obtain a b where "(a, b, cnj b, cnj a) = (1 / d) *⇩s⇩m M ∨ (a, b, -cnj b, -cnj a) = (1 / d) *⇩s⇩m M"
using unitary11_gen_special[of "(1 / d) *⇩s⇩m M"]
by force
thus ?rhs
proof
assume "(a, b, cnj b, cnj a) = (1 / d) *⇩s⇩m M"
moreover
hence "mat_det (a, b, cnj b, cnj a) ≠ 0"
using unitary11_gen_regular[OF ‹unitary11_gen M›] ‹d ≠ 0›
by auto
ultimately
show ?rhs
using ‹d ≠ 0›
by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="d" in exI, simp)
next
assume *: "(a, b, -cnj b, -cnj a) = (1 / d) *⇩s⇩m M"
hence " (1 / d) *⇩s⇩m M = (a, b, -cnj b, -cnj a)"
by simp
hence "M = (a * d, b * d, - (d * cnj b), - (d * cnj a))"
using ‹d ≠ 0›
using mult_sm_inv_l[of "1/d" M "(a, b, -cnj b, -cnj a)", symmetric]
by (simp add: field_simps)
moreover
have "mat_det (a, b, -cnj b, -cnj a) ≠ 0"
using * unitary11_gen_regular[OF ‹unitary11_gen M›] ‹d ≠ 0›
by auto
ultimately
show ?thesis
using ‹d ≠ 0›
by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="-d" in exI) (simp add: field_simps)
qed
next
assume ?rhs
then obtain a b k where "k ≠ 0" "mat_det (a, b, cnj b, cnj a) ≠ 0"
"M = k *⇩s⇩m (a, b, cnj b, cnj a) ∨ M = k *⇩s⇩m (-1, 0, 0, 1) *⇩m⇩m (a, b, cnj b, cnj a)"
by auto
moreover
let ?x = "cnj k * cnj a * (k * a) + - (cnj k * b * (k * cnj b))"
have "?x = (k*cnj k)*(a*cnj a - b*cnj b)"
by (auto simp add: field_simps)
hence "is_real ?x"
by simp
hence "cor (Re ?x) = ?x"
by (rule complex_of_real_Re)
moreover
have "?x ≠ 0"
using mult_eq_0_iff[of "cnj k * k" "(cnj a * a + - cnj b * b)"]
using ‹mat_det (a, b, cnj b, cnj a) ≠ 0› ‹k ≠ 0›
by (auto simp add: field_simps)
hence "Re ?x ≠ 0"
using ‹is_real ?x›
by (metis calculation(4) of_real_0)
ultimately
show ?lhs
unfolding unitary11_gen_real
by (rule_tac x="Re ?x" in exI) (auto simp add: mat_adj_def mat_cnj_def)
qed
text ‹Another characterization of all generalized unitary11 matrices. They are products of
rotation and Blaschke factor matrices.›
lemma unitary11_gen_cis_blaschke:
assumes "k ≠ 0" and "M = k *⇩s⇩m (a, b, cnj b, cnj a)" and
"a ≠ 0" and "mat_det (a, b, cnj b, cnj a) ≠ 0"
shows "∃ k' φ a'. k' ≠ 0 ∧ a' * cnj a' ≠ 1 ∧
M = k' *⇩s⇩m (cis φ, 0, 0, 1) *⇩m⇩m (1, -a', -cnj a', 1)"
proof-
have "a = cnj a * cis (2 * arg a)"
using rcis_cmod_arg[of a] rcis_cnj[of a]
using cis_rcis_eq rcis_mult
by simp
thus ?thesis
using assms
by (rule_tac x="k*cnj a" in exI, rule_tac x="2*arg a" in exI, rule_tac x="- b / a" in exI) (auto simp add: field_simps)
qed
lemma unitary11_gen_cis_blaschke':
assumes "k ≠ 0" and "M = k *⇩s⇩m (-1, 0, 0, 1) *⇩m⇩m (a, b, cnj b, cnj a)" and
"a ≠ 0" and "mat_det (a, b, cnj b, cnj a) ≠ 0"
shows "∃ k' φ a'. k' ≠ 0 ∧ a' * cnj a' ≠ 1 ∧
M = k' *⇩s⇩m (cis φ, 0, 0, 1) *⇩m⇩m (1, -a', -cnj a', 1)"
proof-
obtain k' φ a' where *: "k' ≠ 0" "k *⇩s⇩m (a, b, cnj b, cnj a) = k' *⇩s⇩m (cis φ, 0, 0, 1) *⇩m⇩m (1, -a', -cnj a', 1)" "a' * cnj a' ≠ 1"
using unitary11_gen_cis_blaschke[OF ‹k ≠ 0› _ ‹a ≠ 0›] ‹mat_det (a, b, cnj b, cnj a) ≠ 0›
by blast
have "(cis φ, 0, 0, 1) *⇩m⇩m (-1, 0, 0, 1) = (cis (φ + pi), 0, 0, 1)"
by (simp add: cis_def complex.corec Complex_eq)
thus ?thesis
using * ‹M = k *⇩s⇩m (-1, 0, 0, 1) *⇩m⇩m (a, b, cnj b, cnj a)›
by (rule_tac x="k'" in exI, rule_tac x="φ + pi" in exI, rule_tac x="a'" in exI, simp)
qed
lemma unitary11_gen_cis_blaschke_rev:
assumes "k' ≠ 0" and "M = k' *⇩s⇩m (cis φ, 0, 0, 1) *⇩m⇩m (1, -a', -cnj a', 1)" and
"a' * cnj a' ≠ 1"
shows "∃ k a b. k ≠ 0 ∧ mat_det (a, b, cnj b, cnj a) ≠ 0 ∧
M = k *⇩s⇩m (a, b, cnj b, cnj a)"
using assms
apply (rule_tac x="k'*cis(φ/2)" in exI, rule_tac x="cis(φ/2)" in exI, rule_tac x="-a'*cis(φ/2)" in exI)
apply (simp add: cis_mult mult.commute mult.left_commute)
done
lemma unitary11_gen_cis_inversion:
assumes "k ≠ 0" and "M = k *⇩s⇩m (0, b, cnj b, 0)" and "b ≠ 0"
shows "∃ k' φ. k' ≠ 0 ∧
M = k' *⇩s⇩m (cis φ, 0, 0, 1) *⇩m⇩m (0, 1, 1, 0)"
using assms
using rcis_cmod_arg[of b, symmetric] rcis_cnj[of b] cis_rcis_eq
by simp (rule_tac x="2*arg b" in exI, simp add: rcis_mult)
lemma unitary11_gen_cis_inversion':
assumes "k ≠ 0" and "M = k *⇩s⇩m (-1, 0, 0, 1) *⇩m⇩m (0, b, cnj b, 0)" and "b ≠ 0"
shows "∃ k' φ. k' ≠ 0 ∧
M = k' *⇩s⇩m (cis φ, 0, 0, 1) *⇩m⇩m (0, 1, 1, 0)"
proof-
obtain k' φ where *: "k' ≠ 0" "k *⇩s⇩m (0, b, cnj b, 0) = k' *⇩s⇩m (cis φ, 0, 0, 1) *⇩m⇩m (0, 1, 1, 0)"
using unitary11_gen_cis_inversion[OF ‹k ≠ 0› _ ‹b ≠ 0›]
by metis
have "(cis φ, 0, 0, 1) *⇩m⇩m (-1, 0, 0, 1) = (cis (φ + pi), 0, 0, 1)"
by (simp add: cis_def complex.corec Complex_eq)
thus ?thesis
using * ‹M = k *⇩s⇩m (-1, 0, 0, 1) *⇩m⇩m (0, b, cnj b, 0)›
by (rule_tac x="k'" in exI, rule_tac x="φ + pi" in exI, simp)
qed
lemma unitary11_gen_cis_inversion_rev:
assumes "k' ≠ 0" and "M = k' *⇩s⇩m (cis φ, 0, 0, 1) *⇩m⇩m (0, 1, 1, 0)"
shows "∃ k a b. k ≠ 0 ∧ mat_det (a, b, cnj b, cnj a) ≠ 0 ∧
M = k *⇩s⇩m (a, b, cnj b, cnj a)"
using assms
by (rule_tac x="k'*cis(φ/2)" in exI, rule_tac x=0 in exI, rule_tac x="cis(φ/2)" in exI) (simp add: cis_mult)
text ‹Another characterization of generalized unitary11 matrices›
lemma unitary11_gen_iff:
shows "unitary11_gen M ⟷
(∃ k a b. k ≠ 0 ∧ mat_det (a, b, cnj b, cnj a) ≠ 0 ∧
M = k *⇩s⇩m (a, b, cnj b, cnj a))" (is "?lhs = ?rhs")
proof
assume ?lhs
then obtain a b k where *: "k ≠ 0" "mat_det (a, b, cnj b, cnj a) ≠ 0" "M = k *⇩s⇩m (a, b, cnj b, cnj a) ∨ M = k *⇩s⇩m (-1, 0, 0, 1) *⇩m⇩m (a, b, cnj b, cnj a)"
using unitary11_gen_iff'
by auto
show ?rhs
proof (cases "M = k *⇩s⇩m (a, b, cnj b, cnj a)")
case True
thus ?thesis
using *
by auto
next
case False
hence **: "M = k *⇩s⇩m (-1, 0, 0, 1) *⇩m⇩m (a, b, cnj b, cnj a)"
using *
by simp
show ?thesis
proof (cases "a = 0")
case True
hence "b ≠ 0"
using *
by auto
show ?thesis
using unitary11_gen_cis_inversion_rev[of _ M]
using ** ‹a = 0›
using unitary11_gen_cis_inversion'[OF ‹k ≠ 0› _ ‹b ≠ 0›, of M]
by auto
next
case False
show ?thesis
using unitary11_gen_cis_blaschke_rev[of _ M]
using **
using unitary11_gen_cis_blaschke'[OF ‹k ≠ 0› _ ‹a ≠ 0›, of M b] ‹mat_det (a, b, cnj b, cnj a) ≠ 0›
by blast
qed
qed
next
assume ?rhs
thus ?lhs
using unitary11_gen_iff'
by auto
qed
lemma unitary11_iff:
shows "unitary11 M ⟷
(∃ a b k. (cmod a)⇧2 > (cmod b)⇧2 ∧
(cmod k)⇧2 = 1 / ((cmod a)⇧2 - (cmod b)⇧2) ∧
M = k *⇩s⇩m (a, b, cnj b, cnj a))" (is "?lhs = ?rhs")
proof
assume ?lhs
obtain k a b where *:
"M = k *⇩s⇩m (a, b, cnj b, cnj a)""mat_det (a, b, cnj b, cnj a) ≠ 0" "k ≠ 0"
using unitary11_gen_iff unitary11_unitary11_gen[OF ‹unitary11 M›]
by auto
have md: "mat_det (a, b, cnj b, cnj a) = cor ((cmod a)⇧2 - (cmod b)⇧2)"
by (auto simp add: complex_mult_cnj_cmod)
hence **: "(cmod a)⇧2 ≠ (cmod b)⇧2"
using ‹mat_det (a, b, cnj b, cnj a) ≠ 0›
by auto
have "k * cnj k * mat_det (a, b, cnj b, cnj a) = 1"
using ‹M = k *⇩s⇩m (a, b, cnj b, cnj a)›
using ‹unitary11 M›
unfolding unitary11_def
by (auto simp add: mat_adj_def mat_cnj_def) (simp add: field_simps)
hence ***: "(cmod k)⇧2 * ((cmod a)⇧2 - (cmod b)⇧2) = 1"
by (metis complex_mult_cnj_cmod md of_real_1 of_real_eq_iff of_real_mult)
hence "((cmod a)⇧2 - (cmod b)⇧2) = 1 / (cmod k)⇧2"
by (cases "k=0") (auto simp add: field_simps)
hence "cmod a ^ 2 = cmod b ^ 2 + 1 / cmod k ^ 2"
by simp
thus ?rhs
using ‹M = k *⇩s⇩m (a, b, cnj b, cnj a)› ** mat_eye_l
by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI)
(auto simp add: complex_mult_cnj_cmod intro!: )
next
assume ?rhs
then obtain a b k where "(cmod b)⇧2 < (cmod a)⇧2 ∧ (cmod k)⇧2 = 1 / ((cmod a)⇧2 - (cmod b)⇧2) ∧ M = k *⇩s⇩m (a, b, cnj b, cnj a)"
by auto
moreover
have "cnj k * cnj a * (k * a) + - (cnj k * b * (k * cnj b)) = (cor ((cmod k)⇧2 * ((cmod a)⇧2 - (cmod b)⇧2)))"
proof-
have "cnj k * cnj a * (k * a) = cor ((cmod k)⇧2 * (cmod a)⇧2)"
using complex_mult_cnj_cmod[of a] complex_mult_cnj_cmod[of k]
by (auto simp add: field_simps)
moreover
have "cnj k * b * (k * cnj b) = cor ((cmod k)⇧2 * (cmod b)⇧2)"
using complex_mult_cnj_cmod[of b, symmetric] complex_mult_cnj_cmod[of k]
by (auto simp add: field_simps)
ultimately
show ?thesis
by (auto simp add: field_simps)
qed
ultimately
show ?lhs
unfolding unitary11_def
by (auto simp add: mat_adj_def mat_cnj_def field_simps)
qed
subsubsection ‹Group properties›
text ‹Generalized unitary11 matrices form a group under
multiplication (it is sometimes denoted by $GU_{1, 1}(2,
\mathbb{C})$). The group is also closed under non-zero complex scalar
multiplication. Since these matrices are always regular, they form a
subgroup of general linear group (usually denoted by $GL(2,
\mathbb{C})$) of all regular matrices.›
lemma unitary11_gen_mult_sm:
assumes "k ≠ 0" and "unitary11_gen M"
shows "unitary11_gen (k *⇩s⇩m M)"
proof-
have "k * cnj k = cor (Re (k * cnj k))"
by (subst complex_of_real_Re) auto
thus ?thesis
using assms
unfolding unitary11_gen_real
by auto (rule_tac x="Re (k*cnj k) * ka" in exI, auto)
qed
lemma unitary11_gen_div_sm:
assumes "k ≠ 0" and "unitary11_gen (k *⇩s⇩m M)"
shows "unitary11_gen M"
using assms unitary11_gen_mult_sm[of "1/k" "k *⇩s⇩m M"]
by simp
lemma unitary11_inv:
assumes "k ≠ 0" and "M = k *⇩s⇩m (a, b, cnj b, cnj a)" and "mat_det (a, b, cnj b, cnj a) ≠ 0"
shows "∃ k' a' b'. k' ≠ 0 ∧ mat_inv M = k' *⇩s⇩m (a', b', cnj b', cnj a') ∧ mat_det (a', b', cnj b', cnj a') ≠ 0"
using assms
by (subst assms, subst mat_inv_mult_sm[OF assms(1)])
(rule_tac x="1/(k * mat_det (a, b, cnj b, cnj a))" in exI, rule_tac x="cnj a" in exI, rule_tac x="-b" in exI, simp add: field_simps)
lemma unitary11_comp:
assumes "k1 ≠ 0" and "M1 = k1 *⇩s⇩m (a1, b1, cnj b1, cnj a1)" and "mat_det (a1, b1, cnj b1, cnj a1) ≠ 0"
"k2 ≠ 0" "M2 = k2 *⇩s⇩m (a2, b2, cnj b2, cnj a2)" "mat_det (a2, b2, cnj b2, cnj a2) ≠ 0"
shows "∃ k a b. k ≠ 0 ∧ M1 *⇩m⇩m M2 = k *⇩s⇩m (a, b, cnj b, cnj a) ∧ mat_det (a, b, cnj b, cnj a) ≠ 0"
using assms
apply (rule_tac x="k1*k2" in exI)
apply (rule_tac x="a1*a2 + b1*cnj b2" in exI)
apply (rule_tac x="a1*b2 + b1*cnj a2" in exI)
proof (auto simp add: algebra_simps)
assume *: "a1 * (a2 * (cnj a1 * cnj a2)) + b1 * (b2 * (cnj b1 * cnj b2)) =
a1 * (b2 * (cnj a1 * cnj b2)) + a2 * (b1 * (cnj a2 * cnj b1))" and
**: "a1*cnj a1 ≠ b1 * cnj b1" "a2*cnj a2 ≠ b2*cnj b2"
hence "(a1*cnj a1)*(a2*cnj a2 - b2*cnj b2) = (b1*cnj b1)*(a2*cnj a2 - b2*cnj b2)"
by (simp add: field_simps)
hence "a1*cnj a1 = b1*cnj b1"
using **(2)
by simp
thus False
using **(1)
by simp
qed
lemma unitary11_gen_mat_inv:
assumes "unitary11_gen M" and "mat_det M ≠ 0"
shows "unitary11_gen (mat_inv M)"
proof-
obtain k a b where "k ≠ 0 ∧ mat_det (a, b, cnj b, cnj a) ≠ 0 ∧ M = k *⇩s⇩m (a, b, cnj b, cnj a)"
using assms unitary11_gen_iff[of M]
by auto
then obtain k' a' b' where "k' ≠ 0 ∧ mat_inv M = k' *⇩s⇩m (a', b', cnj b', cnj a') ∧ mat_det (a', b', cnj b', cnj a') ≠ 0"
using unitary11_inv [of k M a b]
by auto
thus ?thesis
using unitary11_gen_iff[of "mat_inv M"]
by auto
qed
lemma unitary11_gen_comp:
assumes "unitary11_gen M1" and "mat_det M1 ≠ 0" and "unitary11_gen M2" and "mat_det M2 ≠ 0"
shows "unitary11_gen (M1 *⇩m⇩m M2)"
proof-
from assms obtain k1 k2 a1 a2 b1 b2 where
"k1 ≠ 0 ∧ mat_det (a1, b1, cnj b1, cnj a1) ≠ 0 ∧ M1 = k1 *⇩s⇩m (a1, b1, cnj b1, cnj a1)"
"k2 ≠ 0 ∧ mat_det (a2, b2, cnj b2, cnj a2) ≠ 0 ∧ M2 = k2 *⇩s⇩m (a2, b2, cnj b2, cnj a2)"
using unitary11_gen_iff[of M1] unitary11_gen_iff[of M2]
by blast
then obtain k a b where "k ≠ 0 ∧ M1 *⇩m⇩m M2 = k *⇩s⇩m (a, b, cnj b, cnj a) ∧ mat_det (a, b, cnj b, cnj a) ≠ 0"
using unitary11_comp[of k1 M1 a1 b1 k2 M2 a2 b2]
by blast
thus ?thesis
using unitary11_gen_iff[of "M1 *⇩m⇩m M2"]
by blast
qed
text ‹Classification into orientation-preserving and orientation-reversing matrices›
lemma unitary11_sgn_det_orientation:
assumes "k ≠ 0" and "mat_det (a, b, cnj b, cnj a) ≠ 0" and "M = k *⇩s⇩m (a, b, cnj b, cnj a)"
shows "∃ k'. sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a))) ∧ congruence M (1, 0, 0, -1) = cor k' *⇩s⇩m (1, 0, 0, -1)"
proof-
let ?x = "cnj k * cnj a * (k * a) - (cnj k * b * (k * cnj b))"
have *: "?x = k * cnj k * (a * cnj a - b * cnj b)"
by (auto simp add: field_simps)
hence "is_real ?x"
by auto
hence "cor (Re ?x) = ?x"
by (rule complex_of_real_Re)
moreover
have "sgn (Re ?x) = sgn (Re (a * cnj a - b * cnj b))"
proof-
have *: "Re ?x = (cmod k)⇧2 * Re (a * cnj a - b * cnj b)"
by (subst *, subst complex_mult_cnj_cmod, subst Re_mult_real) (metis Im_complex_of_real, metis Re_complex_of_real)
show ?thesis
using ‹k ≠ 0›
by (subst *) (simp add: sgn_mult)
qed
ultimately
show ?thesis
using assms(3)
by (rule_tac x="Re ?x" in exI) (auto simp add: mat_adj_def mat_cnj_def)
qed
lemma unitary11_sgn_det:
assumes "k ≠ 0" and "mat_det (a, b, cnj b, cnj a) ≠ 0" and "M = k *⇩s⇩m (a, b, cnj b, cnj a)" and "M = (A, B, C, D)"
shows "sgn (Re (mat_det (a, b, cnj b, cnj a))) = (if b = 0 then 1 else sgn (Re ((A*D)/(B*C)) - 1))"
proof (cases "b = 0")
case True
thus ?thesis
using assms
by (simp only: mat_det.simps, subst complex_mult_cnj_cmod, subst minus_complex.sel, subst Re_complex_of_real, simp)
next
case False
from assms have *: "A = k * a" "B = k * b" "C = k * cnj b" "D = k * cnj a"
by auto
hence *: "(A*D)/(B*C) = (a*cnj a)/(b*cnj b)"
using ‹k ≠ 0›
by simp
show ?thesis
using ‹b ≠ 0›
apply (subst *, subst Re_divide_real, simp, simp)
apply (simp only: mat_det.simps)
apply (subst complex_mult_cnj_cmod)+
apply ((subst Re_complex_of_real)+, subst minus_complex.sel, (subst Re_complex_of_real)+, simp add: field_simps sgn_if)
done
qed
lemma unitary11_orientation:
assumes "unitary11_gen M" and "M = (A, B, C, D)"
shows "∃ k'. sgn k' = sgn (if B = 0 then 1 else sgn (Re ((A*D)/(B*C)) - 1)) ∧ congruence M (1, 0, 0, -1) = cor k' *⇩s⇩m (1, 0, 0, -1)"
proof-
from ‹unitary11_gen M›
obtain k a b where *: "k ≠ 0" "mat_det (a, b, cnj b, cnj a) ≠ 0" "M = k*⇩s⇩m (a, b, cnj b, cnj a)"
using unitary11_gen_iff[of M]
by auto
moreover
have "b = 0 ⟷ B = 0"
using ‹M = (A, B, C, D)› *
by auto
ultimately
show ?thesis
using unitary11_sgn_det_orientation[OF *] unitary11_sgn_det[OF * ‹M = (A, B, C, D)›]
by auto
qed
lemma unitary11_sgn_det_orientation':
assumes "congruence M (1, 0, 0, -1) = cor k' *⇩s⇩m (1, 0, 0, -1)" and "k' ≠ 0"
shows "∃ a b k. k ≠ 0 ∧ M = k *⇩s⇩m (a, b, cnj b, cnj a) ∧ sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a)))"
proof-
obtain a b k where
"k ≠ 0" "mat_det (a, b, cnj b, cnj a) ≠ 0" "M = k *⇩s⇩m (a, b, cnj b, cnj a)"
using assms
using unitary11_gen_iff[of M]
unfolding unitary11_gen_def
by auto
moreover
have "sgn k' = sgn (Re (mat_det (a, b, cnj b, cnj a)))"
proof-
let ?x = "cnj k * cnj a * (k * a) - (cnj k * b * (k * cnj b))"
have *: "?x = k * cnj k * (a * cnj a - b * cnj b)"
by (auto simp add: field_simps)
hence "is_real ?x"
by auto
hence "cor (Re ?x) = ?x"
by (rule complex_of_real_Re)
have **: "sgn (Re ?x) = sgn (Re (a * cnj a - b * cnj b))"
proof-
have *: "Re ?x = (cmod k)⇧2 * Re (a * cnj a - b * cnj b)"
by (subst *, subst complex_mult_cnj_cmod, subst Re_mult_real) (metis Im_complex_of_real, metis Re_complex_of_real)
show ?thesis
using ‹k ≠ 0›
by (subst *) (simp add: sgn_mult)
qed
moreover
have "?x = cor k'"
using ‹M = k *⇩s⇩m (a, b, cnj b, cnj a)› assms
by (simp add: mat_adj_def mat_cnj_def)
hence "sgn (Re ?x) = sgn k'"
using ‹cor (Re ?x) = ?x›
unfolding complex_of_real_def
by simp
ultimately
show ?thesis
by simp
qed
ultimately
show ?thesis
by (rule_tac x="a" in exI, rule_tac x="b" in exI, rule_tac x="k" in exI) simp
qed
end
Theory Hermitean_Matrices
subsection ‹Hermitean matrices›
text ‹Hermitean matrices over $\mathbb{C}$ generalize symmetric matrices over $\mathbb{R}$. Quadratic
forms with Hermitean matrices represent circles and lines in the extended complex plane (when
applied to homogenous coordinates).›
theory Hermitean_Matrices
imports Unitary_Matrices
begin
definition hermitean :: "complex_mat ⇒ bool" where
"hermitean A ⟷ mat_adj A = A"
lemma hermitean_transpose:
shows "hermitean A ⟷ mat_transpose A = mat_cnj A"
unfolding hermitean_def
by (cases A) (auto simp add: mat_adj_def mat_cnj_def)
text ‹Characterization of 2x2 Hermitean matrices elements.
All 2x2 Hermitean matrices are of the form
$$
\left(
\begin{array}{cc}
A & B\\
\overline{B} & D
\end{array}
\right),
$$
for real $A$ and $D$ and complex $B$.
›
lemma hermitean_mk_circline [simp]:
shows "hermitean (cor A, B, cnj B, cor D)"
unfolding hermitean_def mat_adj_def mat_cnj_def
by simp
lemma hermitean_mk_circline' [simp]:
assumes "is_real A" and "is_real D"
shows "hermitean (A, B, cnj B, D)"
using assms eq_cnj_iff_real
unfolding hermitean_def mat_adj_def mat_cnj_def
by force
lemma hermitean_elems:
assumes "hermitean (A, B, C, D)"
shows "is_real A" and "is_real D" and "B = cnj C" and "cnj B = C"
using assms eq_cnj_iff_real[of A] eq_cnj_iff_real[of D]
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
text ‹Operations that preserve the Hermitean property›
lemma hermitean_mat_cnj:
shows "hermitean H ⟷ hermitean (mat_cnj H)"
by (cases H) (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lemma hermitean_mult_real:
assumes "hermitean H"
shows "hermitean ((cor k) *⇩s⇩m H)"
using assms
unfolding hermitean_def
by simp
lemma hermitean_congruence:
assumes "hermitean H"
shows "hermitean (congruence M H)"
using assms
unfolding hermitean_def
by (auto simp add: mult_mm_assoc)
text ‹Identity matrix is Hermitean›
lemma hermitean_eye [simp]:
shows "hermitean eye"
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lemma hermitean_eye' [simp]:
shows "hermitean (1, 0, 0, 1)"
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
text ‹Unit circle matrix is Hermitean›
lemma hermitean_unit_circle [simp]:
shows "hermitean (1, 0, 0, -1)"
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
text ‹Hermitean matrices have real determinant›
lemma mat_det_hermitean_real:
assumes "hermitean A"
shows "is_real (mat_det A)"
using assms
unfolding hermitean_def
by (metis eq_cnj_iff_real mat_det_adj)
text ‹Zero matrix is the only Hermitean matrix with both determinant and trace equal
to zero›
lemma hermitean_det_zero_trace_zero:
assumes "mat_det A = 0" and "mat_trace A = (0::complex)" and "hermitean A"
shows "A = mat_zero"
using assms
proof-
{
fix a d c
assume "a * d = cnj c * c" "a + d = 0" "cnj a = a"
from ‹a + d = 0› have "d = -a"
by (metis add_eq_0_iff)
hence "- (cor (Re a))⇧2 = (cor (cmod c))⇧2"
using ‹cnj a = a› eq_cnj_iff_real[of a]
using ‹a*d = cnj c * c›
using complex_mult_cnj_cmod[of "cnj c"]
by (simp add: power2_eq_square)
hence "- (Re a)⇧2 ≥ 0"
using zero_le_power2[of "cmod c"]
by (metis Re_complex_of_real of_real_minus of_real_power)
hence "a = 0"
using zero_le_power2[of "Re a"]
using ‹cnj a = a› eq_cnj_iff_real[of a]
by (simp add: complex_eq_if_Re_eq)
} note * = this
obtain a b c d where "A = (a, b, c, d)"
by (cases A) auto
thus ?thesis
using *[of a d c] *[of d a c]
using assms ‹A = (a, b, c, d)›
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
qed
subsubsection ‹Bilinear and quadratic forms with Hermitean matrices›
text ‹A Hermitean matrix $(A, B, \overline{B}, D)$, for real $A$ and $D$, gives rise to bilinear form
$A\cdot \overline{v_{11}} \cdot v_{21}+\overline{B} \cdot \overline{v_{12}} \cdot v_{21} +
B \cdot \overline{v_{11}} \cdot v_{22}+D\cdot \overline{v_{12}}\cdot v_{22}$ (acting on vectors $(v_{11}, v_{12})$ and
$(v_{21}, v_{22})$) and to the quadratic form $A \cdot \overline{v_1} \cdot v_1+\overline{B}\cdot \overline{v_2}\cdot v_1 +
B\cdot \overline{v_1}\cdot v_2 + D\cdot \overline{v_2} \cdot v_2$ (acting on the vector $(v_1, v_2)$).›
lemma bilinear_form_hermitean_commute:
assumes "hermitean H"
shows "bilinear_form v1 v2 H = cnj (bilinear_form v2 v1 H)"
proof-
have "v2 *⇩v⇩m mat_cnj H *⇩v⇩v vec_cnj v1 = vec_cnj v1 *⇩v⇩v (mat_adj H *⇩m⇩v v2)"
by (subst mult_vv_commute, subst mult_mv_mult_vm, simp add: mat_adj_def mat_transpose_mat_cnj)
also
have "… = bilinear_form v1 v2 H"
using assms
by (simp add: mult_vv_mv hermitean_def)
finally
show ?thesis
by (simp add: cnj_mult_vv vec_cnj_mult_vm)
qed
lemma quad_form_hermitean_real:
assumes "hermitean H"
shows "is_real (quad_form z H)"
using assms
by (subst eq_cnj_iff_real[symmetric]) (simp del: quad_form_def add: hermitean_def)
lemma quad_form_vec_cnj_mat_cnj:
assumes "hermitean H"
shows "quad_form (vec_cnj z) (mat_cnj H) = quad_form z H"
using assms
using cnj_mult_vv cnj_quad_form hermitean_def vec_cnj_mult_vm by auto
subsubsection ‹Eigenvalues, eigenvectors and diagonalization of Hermitean matrices›
text ‹Hermitean matrices have real eigenvalues›
lemma hermitean_eigenval_real:
assumes "hermitean H" and "eigenval k H"
shows "is_real k"
proof-
from assms obtain v where "v ≠ vec_zero" "H *⇩m⇩v v = k *⇩s⇩v v"
unfolding eigenval_def
by blast
have "k * (v *⇩v⇩v vec_cnj v) = (k *⇩s⇩v v) *⇩v⇩v (vec_cnj v)"
by (simp add: mult_vv_scale_sv1)
also have "... = (H *⇩m⇩v v) *⇩v⇩v (vec_cnj v)"
using ‹H *⇩m⇩v v = k *⇩s⇩v v›
by simp
also have "... = v *⇩v⇩v (mat_transpose H *⇩m⇩v (vec_cnj v))"
by (simp add: mult_mv_vv)
also have "... = v *⇩v⇩v (vec_cnj (mat_cnj (mat_transpose H) *⇩m⇩v v))"
by (simp add: vec_cnj_mult_mv)
also have "... = v *⇩v⇩v (vec_cnj (H *⇩m⇩v v))"
using ‹hermitean H›
by (simp add: hermitean_def mat_adj_def)
also have "... = v *⇩v⇩v (vec_cnj (k *⇩s⇩v v))"
using ‹H *⇩m⇩v v = k *⇩s⇩v v›
by simp
finally have "k * (v *⇩v⇩v vec_cnj v) = cnj k * (v *⇩v⇩v vec_cnj v)"
by (simp add: mult_vv_scale_sv2)
hence "k = cnj k"
using ‹v ≠ vec_zero›
using scalsquare_vv_zero[of v]
by (simp add: mult_vv_commute)
thus ?thesis
by (metis eq_cnj_iff_real)
qed
text ‹Non-diagonal Hermitean matrices have distinct eigenvalues›
lemma hermitean_distinct_eigenvals:
assumes "hermitean H"
shows "(∃ k⇩1 k⇩2. k⇩1 ≠ k⇩2 ∧ eigenval k⇩1 H ∧ eigenval k⇩2 H) ∨ mat_diagonal H"
proof-
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
show ?thesis
proof (cases "B = 0")
case True
thus ?thesis
using ‹hermitean H› hermitean_elems[of A B C D] HH
by auto
next
case False
have "(mat_trace H)⇧2 ≠ 4 * mat_det H"
proof (rule ccontr)
have "C = cnj B" "is_real A" "is_real D"
using hermitean_elems HH ‹hermitean H›
by auto
assume "¬ ?thesis"
hence "(A + D)⇧2 = 4*(A*D - B*C)"
using HH
by auto
hence "(A - D)⇧2 = - 4*B*cnj B"
using ‹C = cnj B›
by (auto simp add: power2_eq_square field_simps)
hence "(A - D)⇧2 / cor ((cmod B)⇧2) = -4"
using ‹B ≠ 0› complex_mult_cnj_cmod[of B]
by (auto simp add: field_simps)
hence "(Re A - Re D)⇧2 / (cmod B)⇧2 = -4"
using ‹is_real A› ‹is_real D› ‹B ≠ 0›
using Re_divide_real[of "cor ((cmod B)⇧2)" "(A - D)⇧2"]
by (auto simp add: power2_eq_square)
thus False
by (metis abs_neg_numeral abs_power2 neg_numeral_neq_numeral power_divide)
qed
show ?thesis
apply (rule disjI1)
apply (subst eigen_equation)+
using complex_quadratic_equation_monic_distinct_roots[of "-mat_trace H" "mat_det H"] ‹(mat_trace H)⇧2 ≠ 4 * mat_det H›
by auto
qed
qed
text ‹Eigenvectors corresponding to different eigenvalues of Hermitean matrices are
orthogonal›
lemma hermitean_ortho_eigenvecs:
assumes "hermitean H"
assumes "eigenpair k1 v1 H" and "eigenpair k2 v2 H" and "k1 ≠ k2"
shows "vec_cnj v2 *⇩v⇩v v1 = 0" and "vec_cnj v1 *⇩v⇩v v2 = 0"
proof-
from assms
have "v1 ≠ vec_zero" "H *⇩m⇩v v1 = k1 *⇩s⇩v v1"
"v2 ≠ vec_zero" "H *⇩m⇩v v2 = k2 *⇩s⇩v v2"
unfolding eigenpair_def
by auto
have real_k: "is_real k1" "is_real k2"
using assms
using hermitean_eigenval_real[of H k1]
using hermitean_eigenval_real[of H k2]
unfolding eigenpair_def eigenval_def
by blast+
have "vec_cnj (H *⇩m⇩v v2) = vec_cnj (k2 *⇩s⇩v v2)"
using ‹H *⇩m⇩v v2 = k2 *⇩s⇩v v2›
by auto
hence "vec_cnj v2 *⇩v⇩m H = k2 *⇩s⇩v vec_cnj v2"
using ‹hermitean H› real_k eq_cnj_iff_real[of k1] eq_cnj_iff_real[of k2]
unfolding hermitean_def
by (cases H, cases v2) (auto simp add: mat_adj_def mat_cnj_def vec_cnj_def)
have "k2 * (vec_cnj v2 *⇩v⇩v v1) = k1 * (vec_cnj v2 *⇩v⇩v v1)"
using ‹H *⇩m⇩v v1 = k1 *⇩s⇩v v1›
using ‹vec_cnj v2 *⇩v⇩m H = k2 *⇩s⇩v vec_cnj v2›
by (cases v1, cases v2, cases H)
(metis mult_vv_mv mult_vv_scale_sv1 mult_vv_scale_sv2)
thus "vec_cnj v2 *⇩v⇩v v1 = 0"
using ‹k1 ≠ k2›
by simp
hence "cnj (vec_cnj v2 *⇩v⇩v v1) = 0"
by simp
thus "vec_cnj v1 *⇩v⇩v v2 = 0"
by (simp add: cnj_mult_vv mult_vv_commute)
qed
text ‹Hermitean matrices are diagonizable by unitary matrices. Diagonal entries are
real and the sign of the determinant is preserved.›
lemma hermitean_diagonizable:
assumes "hermitean H"
shows "∃ k1 k2 M. mat_det M ≠ 0 ∧ unitary M ∧ congruence M H = (k1, 0, 0, k2) ∧
is_real k1 ∧ is_real k2 ∧ sgn (Re k1 * Re k2) = sgn (Re (mat_det H))"
proof-
from assms
have "(∃k⇩1 k⇩2. k⇩1 ≠ k⇩2 ∧ eigenval k⇩1 H ∧ eigenval k⇩2 H) ∨ mat_diagonal H"
using hermitean_distinct_eigenvals[of H]
by simp
thus ?thesis
proof
assume "∃k⇩1 k⇩2. k⇩1 ≠ k⇩2 ∧ eigenval k⇩1 H ∧ eigenval k⇩2 H"
then obtain k1 k2 where "k1 ≠ k2" "eigenval k1 H" "eigenval k2 H"
using hermitean_distinct_eigenvals
by blast
then obtain v1 v2 where "eigenpair k1 v1 H" "eigenpair k2 v2 H"
"v1 ≠ vec_zero" "v2 ≠ vec_zero"
unfolding eigenval_def eigenpair_def
by blast
hence *: "vec_cnj v2 *⇩v⇩v v1 = 0" "vec_cnj v1 *⇩v⇩v v2 = 0"
using ‹k1 ≠ k2› hermitean_ortho_eigenvecs ‹hermitean H›
by auto
obtain v11 v12 v21 v22 where vv: "v1 = (v11, v12)" "v2 = (v21, v22)"
by (cases v1, cases v2) auto
let ?nv1' = "vec_cnj v1 *⇩v⇩v v1" and ?nv2' = "vec_cnj v2 *⇩v⇩v v2"
let ?nv1 = "cor (sqrt (Re ?nv1'))"
let ?nv2 = "cor (sqrt (Re ?nv2'))"
have "?nv1' ≠ 0" "?nv2' ≠ 0"
using ‹v1 ≠ vec_zero› ‹v2 ≠ vec_zero› vv
by (simp add: scalsquare_vv_zero)+
moreover
have "is_real ?nv1'" "is_real ?nv2'"
using vv
by (auto simp add: vec_cnj_def)
ultimately
have "?nv1 ≠ 0" "?nv2 ≠ 0"
using complex_eq_if_Re_eq
by auto
have "Re (?nv1') ≥ 0" "Re (?nv2') ≥ 0"
using vv
by (auto simp add: vec_cnj_def)
obtain nv1 nv2 where "nv1 = ?nv1" "nv1 ≠ 0" "nv2 = ?nv2" "nv2 ≠ 0"
using ‹?nv1 ≠ 0› ‹?nv2 ≠ 0›
by auto
let ?M = "(1/nv1 * v11, 1/nv2 * v21, 1/nv1 * v12, 1/nv2 * v22)"
have "is_real k1" "is_real k2"
using ‹eigenval k1 H› ‹eigenval k2 H› ‹hermitean H›
by (auto simp add: hermitean_eigenval_real)
moreover
have "mat_det ?M ≠ 0"
proof (rule ccontr)
assume "¬ ?thesis"
hence "v11 * v22 = v12 * v21"
using ‹nv1 ≠ 0› ‹nv2 ≠ 0›
by (auto simp add: field_simps)
hence "∃ k. k ≠ 0 ∧ v2 = k *⇩s⇩v v1"
using vv ‹v1 ≠ vec_zero› ‹v2 ≠ vec_zero›
apply auto
apply (rule_tac x="v21/v11" in exI, force simp add: field_simps)
apply (rule_tac x="v21/v11" in exI, force simp add: field_simps)
apply (rule_tac x="v22/v12" in exI, force simp add: field_simps)
apply (rule_tac x="v22/v12" in exI, force simp add: field_simps)
done
thus False
using * ‹vec_cnj v1 *⇩v⇩v v2 = 0› ‹vec_cnj v2 *⇩v⇩v v2 ≠ 0› vv ‹?nv1' ≠ 0›
by (metis mult_vv_scale_sv2 mult_zero_right)
qed
moreover
have "unitary ?M"
proof-
have **: "cnj nv1 * nv1 = ?nv1'" "cnj nv2 * nv2 = ?nv2'"
using ‹nv1 = ?nv1› ‹nv1 ≠ 0› ‹nv2 = ?nv2› ‹nv2 ≠ 0› ‹is_real ?nv1'› ‹is_real ?nv2'›
using ‹Re (?nv1') ≥ 0› ‹Re (?nv2') ≥ 0›
by auto
have ***: "cnj nv1 * nv2 ≠ 0" "cnj nv2 * nv1 ≠ 0"
using vv ‹nv1 = ?nv1› ‹nv1 ≠ 0› ‹nv2 = ?nv2› ‹nv2 ≠ 0› ‹is_real ?nv1'› ‹is_real ?nv2'›
by auto
show ?thesis
unfolding unitary_def
using vv ** ‹?nv1' ≠ 0› ‹?nv2' ≠ 0› * ***
unfolding mat_adj_def mat_cnj_def vec_cnj_def
by simp (metis (no_types, lifting) add_divide_distrib divide_eq_0_iff divide_eq_1_iff)
qed
moreover
have "congruence ?M H = (k1, 0, 0, k2)"
proof-
have "mat_inv ?M *⇩m⇩m H *⇩m⇩m ?M = (k1, 0, 0, k2)"
proof-
have *: "H *⇩m⇩m ?M = ?M *⇩m⇩m (k1, 0, 0, k2)"
using ‹eigenpair k1 v1 H› ‹eigenpair k2 v2 H› vv ‹?nv1 ≠ 0› ‹?nv2 ≠ 0›
unfolding eigenpair_def vec_cnj_def
by (cases H) (smt mult_mm.simps vec_map.simps add.right_neutral add_cancel_left_left distrib_left fst_mult_sv mult.commute mult.left_commute mult_mv.simps mult_zero_right prod.sel(1) prod.sel(2) snd_mult_sv)
show ?thesis
using mult_mm_inv_l[of ?M "(k1, 0, 0, k2)" "H *⇩m⇩m ?M", OF ‹mat_det ?M ≠ 0› *[symmetric], symmetric]
by (simp add: mult_mm_assoc)
qed
moreover
have "mat_inv ?M = mat_adj ?M"
using ‹mat_det ?M ≠ 0› ‹unitary ?M› mult_mm_inv_r[of ?M "mat_adj ?M" eye]
by (simp add: unitary_def)
ultimately
show ?thesis
by simp
qed
moreover
have "sgn (Re k1 * Re k2) = sgn (Re (mat_det H))"
using ‹congruence ?M H = (k1, 0, 0, k2)› ‹is_real k1› ‹is_real k2›
using Re_det_sgn_congruence[of ?M H] ‹mat_det ?M ≠ 0› ‹hermitean H›
by simp
ultimately
show ?thesis
by (rule_tac x="k1" in exI, rule_tac x="k2" in exI, rule_tac x="?M" in exI) simp
next
assume "mat_diagonal H"
then obtain A D where "H = (A, 0, 0, D)"
by (cases H) auto
moreover
hence "is_real A" "is_real D"
using ‹hermitean H› hermitean_elems[of A 0 0 D]
by auto
ultimately
show ?thesis
by (rule_tac x="A" in exI, rule_tac x="D" in exI, rule_tac x="eye" in exI) (simp add: unitary_def mat_adj_def mat_cnj_def)
qed
qed
end
Theory Elementary_Complex_Geometry
section ‹Elementary complex geometry›
text ‹In this section equations and basic properties of the most fundamental objects and relations in
geometry -- collinearity, lines, circles and circlines. These are defined by equations in
$\mathbb{C}$ (not extended by an infinite point). Later these equations will be generalized to
equations in the extended complex plane, over homogenous coordinates.›
theory Elementary_Complex_Geometry
imports More_Complex Linear_Systems Angles
begin
subsection ‹Collinear points›
definition collinear :: "complex ⇒ complex ⇒ complex ⇒ bool" where
"collinear z1 z2 z3 ⟷ z1 = z2 ∨ Im ((z3 - z1) / (z2 - z1)) = 0"
lemma collinear_ex_real:
shows "collinear z1 z2 z3 ⟷
(∃ k::real. z1 = z2 ∨ z3 - z1 = complex_of_real k * (z2 - z1))"
unfolding collinear_def
by (metis Im_complex_of_real add_diff_cancel_right' complex_eq diff_zero legacy_Complex_simps(15) nonzero_mult_div_cancel_right right_minus_eq times_divide_eq_left zero_complex.code)
text ‹Collinearity characterization using determinants›
lemma collinear_det:
assumes "¬ collinear z1 z2 z3"
shows "det2 (z3 - z1) (cnj (z3 - z1)) (z1 - z2) (cnj (z1 - z2)) ≠ 0"
proof-
from assms have "((z3 - z1) / (z2 - z1)) - cnj ((z3 - z1) / (z2 - z1)) ≠ 0" "z2 ≠ z1"
unfolding collinear_def
using Complex_Im_express_cnj[of "(z3 - z1) / (z2 - z1)"]
by (auto simp add: Complex_eq)
thus ?thesis
by (auto simp add: field_simps)
qed
text ‹Properties of three collinear points›
lemma collinear_sym1:
shows "collinear z1 z2 z3 ⟷ collinear z1 z3 z2"
unfolding collinear_def
using div_reals[of "1" "(z3 - z1)/(z2 - z1)"] div_reals[of "1" "(z2 - z1)/(z3 - z1)"]
by auto
lemma collinear_sym2':
assumes "collinear z1 z2 z3"
shows "collinear z2 z1 z3"
proof-
obtain k where "z1 = z2 ∨ z3 - z1 = complex_of_real k * (z2 - z1)"
using assms
unfolding collinear_ex_real
by auto
thus ?thesis
proof
assume "z3 - z1 = complex_of_real k * (z2 - z1)"
thus ?thesis
unfolding collinear_ex_real
by (rule_tac x="1-k" in exI) (auto simp add: field_simps)
qed (simp add: collinear_def)
qed
lemma collinear_sym2:
shows "collinear z1 z2 z3 ⟷ collinear z2 z1 z3"
using collinear_sym2'[of z1 z2 z3] collinear_sym2'[of z2 z1 z3]
by auto
text ‹Properties of four collinear points›
lemma collinear_trans1:
assumes "collinear z0 z2 z1" and "collinear z0 z3 z1" and "z0 ≠ z1"
shows "collinear z0 z2 z3"
using assms
unfolding collinear_ex_real
by (cases "z0 = z2", auto) (rule_tac x="k/ka" in exI, case_tac "ka = 0", auto simp add: field_simps)
subsection ‹Euclidean line›
text ‹Line is defined by using collinearity›
definition line :: "complex ⇒ complex ⇒ complex set" where
"line z1 z2 = {z. collinear z1 z2 z}"
lemma line_points_collinear:
assumes "z1 ∈ line z z'" and "z2 ∈ line z z'" and "z3 ∈ line z z'" and "z ≠ z'"
shows "collinear z1 z2 z3"
using assms
unfolding line_def
by (smt collinear_sym1 collinear_sym2' collinear_trans1 mem_Collect_eq)
text ‹Parametric equation of a line›
lemma line_param:
shows "z1 + cor k * (z2 - z1) ∈ line z1 z2"
unfolding line_def
by (auto simp add: collinear_def)
text ‹Equation of the line containing two different given points›
lemma line_equation:
assumes "z1 ≠ z2" and "μ = rot90 (z2 - z1)"
shows "line z1 z2 = {z. cnj μ*z + μ*cnj z - (cnj μ * z1 + μ * cnj z1) = 0}"
proof-
{
fix z
have "z ∈ line z1 z2 ⟷ Im ((z - z1)/(z2 - z1)) = 0"
using assms
by (simp add: line_def collinear_def)
also have "... ⟷ (z - z1)/(z2 - z1) = cnj ((z - z1)/(z2 - z1))"
using complex_diff_cnj[of "(z - z1)/(z2 - z1)"]
by auto
also have "... ⟷ (z - z1)*(cnj z2 - cnj z1) = (cnj z - cnj z1)*(z2 - z1)"
using assms(1)
using ‹(z ∈ line z1 z2) = is_real ((z - z1) / (z2 - z1))› calculation is_real_div
by auto
also have "... ⟷ cnj(z2 - z1)*z - (z2 - z1)*cnj z - (cnj(z2 - z1)*z1 - (z2 - z1)*cnj z1) = 0"
by (simp add: field_simps)
also have "... ⟷ cnj μ * z + μ * cnj z - (cnj μ * z1 + μ * cnj z1) = 0"
apply (subst assms)+
apply (subst cnj_mix_minus)+
by simp
finally have "z ∈ line z1 z2 ⟷ cnj μ * z + μ * cnj z - (cnj μ * z1 + μ * cnj z1) = 0"
.
}
thus ?thesis
by auto
qed
subsection ‹Euclidean circle›
text ‹Definition of the circle with given center and radius. It consists of all
points on the distance $r$ from the center $\mu$.›
definition circle :: "complex ⇒ real ⇒ complex set" where
"circle μ r = {z. cmod (z - μ) = r}"
text ‹Equation of the circle centered at $\mu$ with the radius $r$.›
lemma circle_equation:
assumes "r ≥ 0"
shows "circle μ r = {z. z*cnj z - z*cnj μ - cnj z*μ + μ*cnj μ - cor (r*r) = 0}"
proof (safe)
fix z
assume "z ∈ circle μ r"
hence "(z - μ)*cnj (z - μ) = complex_of_real (r*r)"
unfolding circle_def
using complex_mult_cnj_cmod[of "z - μ"]
by (auto simp add: power2_eq_square)
thus "z * cnj z - z * cnj μ - cnj z * μ + μ * cnj μ - cor (r * r) = 0"
by (auto simp add: field_simps)
next
fix z
assume "z * cnj z - z * cnj μ - cnj z * μ + μ * cnj μ - cor (r * r) = 0"
hence "(z - μ)*cnj (z - μ) = cor (r*r)"
by (auto simp add: field_simps)
thus "z ∈ circle μ r"
using assms
using complex_mult_cnj_cmod[of "z - μ"]
using power2_eq_imp_eq[of "cmod (z - μ)" r]
unfolding circle_def power2_eq_square[symmetric] complex_of_real_def
by auto
qed
subsection ‹Circline›
text ‹A very important property of the extended complex plane is that it is possible to treat circles
and lines in a uniform way. The basic object is \emph{generalized circle}, or \emph{circline} for
short. We introduce circline equation given in $\mathbb{C}$, and it will later be generalized to an
equation in the extended complex plane $\overline{\mathbb{C}}$ given in matrix form using a
Hermitean matrix and a quadratic form over homogenous coordinates.›
definition circline where
"circline A BC D = {z. cor A*z*cnj z + cnj BC*z + BC*cnj z + cor D = 0}"
text ‹Connection between circline and Euclidean circle›
text ‹Every circline with positive determinant and $A \neq 0$ represents an Euclidean circle›
lemma circline_circle:
assumes "A ≠ 0" and "A * D ≤ (cmod BC)⇧2"
"cl = circline A BC D" and
"μ = -BC/cor A" and
"r2 = ((cmod BC)⇧2 - A*D) / A⇧2" and "r = sqrt r2"
shows "cl = circle μ r"
proof-
have *: "cl = {z. z * cnj z + cnj (BC / cor A) * z + (BC / cor A) * cnj z + cor (D / A) = 0}"
using ‹cl = circline A BC D› ‹A ≠ 0›
by (auto simp add: circline_def field_simps)
have "r2 ≥ 0"
proof-
have "(cmod BC)⇧2 - A * D ≥ 0"
using ‹A * D ≤ (cmod BC)⇧2›
by auto
thus ?thesis
using ‹A ≠ 0› ‹r2 = ((cmod BC)⇧2 - A*D) / A⇧2›
by (metis zero_le_divide_iff zero_le_power2)
qed
hence **: "r * r = r2" "r ≥ 0"
using ‹r = sqrt r2›
by (auto simp add: real_sqrt_mult[symmetric])
have ***: "- μ * - cnj μ - cor r2 = cor (D / A)"
using ‹μ = - BC / complex_of_real A› ‹r2 = ((cmod BC)⇧2 - A * D) / A⇧2›
by (auto simp add: power2_eq_square complex_mult_cnj_cmod field_simps)
(simp add: add_divide_eq_iff assms(1))
thus ?thesis
using ‹r2 = ((cmod BC)⇧2 - A*D) / A⇧2› ‹μ = - BC / cor A›
by (subst *, subst circle_equation[of r μ, OF ‹r ≥ 0›], subst **) (auto simp add: field_simps power2_eq_square)
qed
lemma circline_ex_circle:
assumes "A ≠ 0" and "A * D ≤ (cmod BC)⇧2" and "cl = circline A BC D"
shows "∃ μ r. cl = circle μ r"
using circline_circle[OF assms]
by auto
text ‹Every Euclidean circle can be represented by a circline›
lemma circle_circline:
assumes "cl = circle μ r" and "r ≥ 0"
shows "cl = circline 1 (-μ) ((cmod μ)⇧2 - r⇧2)"
proof-
have "complex_of_real ((cmod μ)⇧2 - r⇧2) = μ * cnj μ - complex_of_real (r⇧2)"
by (auto simp add: complex_mult_cnj_cmod)
thus "cl = circline 1 (- μ) ((cmod μ)⇧2 - r⇧2)"
using assms
using circle_equation[of r μ]
unfolding circline_def power2_eq_square
by (simp add: field_simps)
qed
lemma circle_ex_circline:
assumes "cl = circle μ r" and "r ≥ 0"
shows "∃ A BC D. A ≠ 0 ∧ A*D ≤ (cmod BC)⇧2 ∧ cl = circline A BC D"
using circle_circline[OF assms]
using ‹r ≥ 0›
by (rule_tac x=1 in exI, rule_tac x="-μ" in exI, rule_tac x="Re (μ * cnj μ) - (r * r)" in exI) (simp add: complex_mult_cnj_cmod power2_eq_square)
text ‹Connection between circline and Euclidean line›
text ‹Every circline with a positive determinant and $A = 0$ represents an Euclidean line›
lemma circline_line:
assumes
"A = 0" and "BC ≠ 0" and
"cl = circline A BC D" and
"z1 = - cor D * BC / (2 * BC * cnj BC)" and
"z2 = z1 + 𝗂 * sgn (if arg BC > 0 then -BC else BC)"
shows
"cl = line z1 z2"
proof-
have "cl = {z. cnj BC*z + BC*cnj z + complex_of_real D = 0}"
using assms
by (simp add: circline_def)
have "{z. cnj BC*z + BC*cnj z + complex_of_real D = 0} =
{z. cnj BC*z + BC*cnj z - (cnj BC*z1 + BC*cnj z1) = 0}"
using ‹BC ≠ 0› assms
by simp
moreover
have "z1 ≠ z2"
using ‹BC ≠ 0› assms
by (auto simp add: sgn_eq)
moreover
have "∃ k. k ≠ 0 ∧ BC = cor k*rot90 (z2 - z1)"
proof (cases "arg BC > 0")
case True
thus ?thesis
using assms
by (rule_tac x="(cmod BC)" in exI, auto simp add: Complex_scale4)
next
case False
thus ?thesis
using assms
by (rule_tac x="-(cmod BC)" in exI, simp)
(smt Complex.Re_sgn Im_sgn cis_arg complex_minus complex_surj mult_minus_right rcis_cmod_arg rcis_def)
qed
then obtain k where "cor k ≠ 0" "BC = cor k*rot90 (z2 - z1)"
by auto
moreover
have *: "⋀ z. cnj_mix (BC / cor k) z - cnj_mix (BC / cor k) z1 = (1/cor k) * (cnj_mix BC z - cnj_mix BC z1)"
using ‹cor k ≠ 0›
by (simp add: field_simps)
hence "{z. cnj_mix BC z - cnj_mix BC z1 = 0} = {z. cnj_mix (BC / cor k) z - cnj_mix (BC / cor k) z1 = 0}"
using ‹cor k ≠ 0›
by auto
ultimately
have "cl = line z1 z2"
using line_equation[of z1 z2 "BC/cor k"] ‹cl = {z. cnj BC*z + BC*cnj z + complex_of_real D = 0}›
by auto
thus ?thesis
using ‹z1 ≠ z2›
by blast
qed
lemma circline_ex_line:
assumes "A = 0" and "BC ≠ 0" and "cl = circline A BC D"
shows "∃ z1 z2. z1 ≠ z2 ∧ cl = line z1 z2"
proof-
let ?z1 = "- cor D * BC / (2 * BC * cnj BC)"
let ?z2 = "?z1 + 𝗂 * sgn (if 0 < arg BC then - BC else BC)"
have "?z1 ≠ ?z2"
using ‹BC ≠ 0›
by (simp add: sgn_eq)
thus ?thesis
using circline_line[OF assms, of ?z1 ?z2] ‹BC ≠ 0›
by (rule_tac x="?z1" in exI, rule_tac x="?z2" in exI, simp)
qed
text ‹Every Euclidean line can be represented by a circline›
lemma line_ex_circline:
assumes "cl = line z1 z2" and "z1 ≠ z2"
shows "∃ BC D. BC ≠ 0 ∧ cl = circline 0 BC D"
proof-
let ?BC = "rot90 (z2 - z1)"
let ?D = "Re (- 2 * scalprod z1 ?BC)"
show ?thesis
proof (rule_tac x="?BC" in exI, rule_tac x="?D" in exI, rule conjI)
show "?BC ≠ 0"
using ‹z1 ≠ z2› rot90_ii[of "z2 - z1"]
by auto
next
have *: "complex_of_real (Re (- 2 * scalprod z1 (rot90 (z2 - z1)))) = - (cnj_mix z1 (rot90 (z2 - z1)))"
using rot90_ii[of "z2 - z1"]
by (cases z1, cases z2, simp add: Complex_eq field_simps)
show "cl = circline 0 ?BC ?D"
apply (subst assms, subst line_equation[of z1 z2 ?BC])
unfolding circline_def
by (fact, simp, subst *, simp add: field_simps)
qed
qed
lemma circline_line':
assumes "z1 ≠ z2"
shows "circline 0 (𝗂 * (z2 - z1)) (Re (- cnj_mix (𝗂 * (z2 - z1)) z1)) = line z1 z2"
proof-
let ?B = "𝗂 * (z2 - z1)"
let ?D = "Re (- cnj_mix ?B z1)"
have "circline 0 ?B ?D = {z. cnj ?B*z + ?B*cnj z + complex_of_real ?D = 0}"
using assms
by (simp add: circline_def)
moreover
have "is_real (- cnj_mix (𝗂 * (z2 - z1)) z1)"
using cnj_mix_real[of ?B z1]
by auto
hence "{z. cnj ?B*z + ?B*cnj z + complex_of_real ?D = 0} =
{z. cnj ?B*z + ?B*cnj z - (cnj ?B*z1 + ?B*cnj z1) = 0}"
apply (subst complex_of_real_Re, simp)
unfolding diff_conv_add_uminus
by simp
moreover
have "line z1 z2 = {z. cnj_mix (𝗂 * (z2 - z1)) z - cnj_mix (𝗂 * (z2 - z1)) z1 = 0}"
using line_equation[of z1 z2 ?B] assms
unfolding rot90_ii
by simp
ultimately
show ?thesis
by simp
qed
subsection ‹Angle between two circles›
text ‹Given a center $\mu$ of an Euclidean circle and a point $E$ on it, we define the tangent vector
in $E$ as the radius vector $\overrightarrow{\mu E}$, rotated by $\pi/2$, clockwise or
counterclockwise, depending on the circle orientation. The Boolean @{term p} encodes the orientation
of the circle, and the function @{term "sgn_bool p"} returns $1$ when @{term p} is true, and
$-1$ when @{term p} is false.›
abbreviation sgn_bool where
"sgn_bool p ≡ if p then 1 else -1"
definition circ_tang_vec :: "complex ⇒ complex ⇒ bool ⇒ complex" where
"circ_tang_vec μ E p = sgn_bool p * 𝗂 * (E - μ)"
text ‹Tangent vector is orthogonal to the radius.›
lemma circ_tang_vec_ortho:
shows "scalprod (E - μ) (circ_tang_vec μ E p) = 0"
unfolding circ_tang_vec_def Let_def
by auto
text ‹Changing the circle orientation gives the opposite tangent vector.›
lemma circ_tang_vec_opposite_orient:
shows "circ_tang_vec μ E p = - circ_tang_vec μ E (¬ p)"
unfolding circ_tang_vec_def
by auto
text ‹Angle between two oriented circles at their common point $E$ is defined as the angle between
tangent vectors at $E$. Again we define three different angle measures.›
text ‹The oriented angle between two circles at the point $E$. The first circle is
centered at $\mu_1$ and its orientation is given by the Boolean $p_1$,
while the second circle is centered at $\mu_2$ and its orientation is given by
the Boolea $p_2$.›
definition ang_circ where
"ang_circ E μ1 μ2 p1 p2 = ∠ (circ_tang_vec μ1 E p1) (circ_tang_vec μ2 E p2)"
text ‹The unoriented angle between the two circles›
definition ang_circ_c where
"ang_circ_c E μ1 μ2 p1 p2 = ∠c (circ_tang_vec μ1 E p1) (circ_tang_vec μ2 E p2)"
text ‹The acute angle between the two circles›
definition ang_circ_a where
"ang_circ_a E μ1 μ2 p1 p2 = ∠a (circ_tang_vec μ1 E p1) (circ_tang_vec μ2 E p2)"
text ‹Explicit expression for oriented angle between two circles›
lemma ang_circ_simp:
assumes "E ≠ μ1" and "E ≠ μ2"
shows "ang_circ E μ1 μ2 p1 p2 =
⇂arg (E - μ2) - arg (E - μ1) + sgn_bool p1 * pi / 2 - sgn_bool p2 * pi / 2⇃"
unfolding ang_circ_def ang_vec_def circ_tang_vec_def
apply (rule canon_ang_eq)
using assms
using arg_mult_2kpi[of "sgn_bool p2*𝗂" "E - μ2"]
using arg_mult_2kpi[of "sgn_bool p1*𝗂" "E - μ1"]
apply auto
apply (rule_tac x="x-xa" in exI, auto simp add: field_simps)
apply (rule_tac x="-1+x-xa" in exI, auto simp add: field_simps)
apply (rule_tac x="1+x-xa" in exI, auto simp add: field_simps)
apply (rule_tac x="x-xa" in exI, auto simp add: field_simps)
done
text ‹Explicit expression for the cosine of angle between two circles›
lemma cos_ang_circ_simp:
assumes "E ≠ μ1" and "E ≠ μ2"
shows "cos (ang_circ E μ1 μ2 p1 p2) =
sgn_bool (p1 = p2) * cos (arg (E - μ2) - arg (E - μ1))"
using assms
using cos_periodic_pi2[of "arg (E - μ2) - arg (E - μ1)"]
using cos_minus_pi[of "arg (E - μ2) - arg (E - μ1)"]
using ang_circ_simp[OF assms, of p1 p2]
by auto
text ‹Explicit expression for the unoriented angle between two circles›
lemma ang_circ_c_simp:
assumes "E ≠ μ1" and "E ≠ μ2"
shows "ang_circ_c E μ1 μ2 p1 p2 =
¦⇂arg (E - μ2) - arg (E - μ1) + sgn_bool p1 * pi / 2 - sgn_bool p2 * pi / 2⇃¦"
unfolding ang_circ_c_def ang_vec_c_def
using ang_circ_simp[OF assms]
unfolding ang_circ_def
by auto
text ‹Explicit expression for the acute angle between two circles›
lemma ang_circ_a_simp:
assumes "E ≠ μ1" and "E ≠ μ2"
shows "ang_circ_a E μ1 μ2 p1 p2 =
acute_ang (abs (canon_ang (arg(E - μ2) - arg(E - μ1) + (sgn_bool p1) * pi/2 - (sgn_bool p2) * pi/2)))"
unfolding ang_circ_a_def ang_vec_a_def
using ang_circ_c_simp[OF assms]
unfolding ang_circ_c_def
by auto
text ‹Acute angle between two circles does not depend on the circle orientation.›
lemma ang_circ_a_pTrue:
assumes "E ≠ μ1" and "E ≠ μ2"
shows "ang_circ_a E μ1 μ2 p1 p2 = ang_circ_a E μ1 μ2 True True"
proof (cases "p1")
case True
show ?thesis
proof (cases "p2")
case True
show ?thesis
using ‹p1› ‹p2›
by simp
next
case False
show ?thesis
using ‹p1› ‹¬ p2›
unfolding ang_circ_a_def
using circ_tang_vec_opposite_orient[of μ2 E p2]
using ang_vec_a_opposite2
by simp
qed
next
case False
show ?thesis
proof (cases "p2")
case True
show ?thesis
using ‹¬ p1› ‹p2›
unfolding ang_circ_a_def
using circ_tang_vec_opposite_orient[of μ1 E p1]
using ang_vec_a_opposite1
by simp
next
case False
show ?thesis
using ‹¬ p1› ‹¬ p2›
unfolding ang_circ_a_def
using circ_tang_vec_opposite_orient[of μ1 E p1] circ_tang_vec_opposite_orient[of μ2 E p2]
using ang_vec_a_opposite1 ang_vec_a_opposite2
by simp
qed
qed
text ‹Definition of the acute angle between the two unoriented circles ›
abbreviation ang_circ_a' where
"ang_circ_a' E μ1 μ2 ≡ ang_circ_a E μ1 μ2 True True"
text ‹A very simple expression for the acute angle between the two circles›
lemma ang_circ_a_simp1:
assumes "E ≠ μ1" and "E ≠ μ2"
shows "ang_circ_a E μ1 μ2 p1 p2 = ∠a (E - μ1) (E - μ2)"
unfolding ang_vec_a_def ang_vec_c_def ang_vec_def
by (subst ang_circ_a_pTrue[OF assms, of p1 p2], subst ang_circ_a_simp[OF assms, of True True]) (metis add_diff_cancel)
lemma ang_circ_a'_simp:
assumes "E ≠ μ1" and "E ≠ μ2"
shows "ang_circ_a' E μ1 μ2 = ∠a (E - μ1) (E - μ2)"
by (rule ang_circ_a_simp1[OF assms])
end
Theory Homogeneous_Coordinates
section ‹Homogeneous coordinates in extended complex plane›
text ‹Extended complex plane $\mathbb{\overline{C}}$ is complex plane with an additional element
(treated as the infinite point). The extended complex plane $\mathbb{\overline{C}}$ is identified
with a complex projective line (the one-dimensional projective space over the complex field, sometimes denoted by $\mathbb{C}P^1$).
Each point of $\mathbb{\overline{C}}$ is represented by a pair of complex homogeneous coordinates (not
both equal to zero), and two pairs of homogeneous coordinates represent the same
point in $\mathbb{\overline{C}}$ iff they are proportional by a non-zero complex factor.›
theory Homogeneous_Coordinates
imports More_Complex Matrices
begin
subsection ‹Definition of homogeneous coordinates›
text ‹Two complex vectors are equivalent iff they are proportional.›
definition complex_cvec_eq :: "complex_vec ⇒ complex_vec ⇒ bool" (infix "≈⇩v" 50) where
[simp]: "z1 ≈⇩v z2 ⟷ (∃ k. k ≠ (0::complex) ∧ z2 = k *⇩s⇩v z1)"
lemma complex_cvec_eq_mix:
assumes "(z1, z2) ≠ vec_zero" and "(w1, w2) ≠ vec_zero"
shows "(z1, z2) ≈⇩v (w1, w2) ⟷ z1*w2 = z2*w1"
proof safe
assume "(z1, z2) ≈⇩v (w1, w2)"
thus "z1 * w2 = z2 * w1"
by auto
next
assume *: "z1 * w2 = z2 * w1"
show "(z1, z2) ≈⇩v (w1, w2)"
proof (cases "z2 = 0")
case True
thus ?thesis
using * assms
by auto
next
case False
hence "w1 = (w2/z2)*z1 ∧ w2 = (w2/z2)*z2" "w2/z2 ≠ 0"
using * assms
by (auto simp add: field_simps)
thus "(z1, z2) ≈⇩v (w1, w2)"
by (metis complex_cvec_eq_def mult_sv.simps)
qed
qed
lemma complex_eq_cvec_reflp [simp]:
shows "reflp (≈⇩v)"
unfolding reflp_def complex_cvec_eq_def
by safe (rule_tac x="1" in exI, simp)
lemma complex_eq_cvec_symp [simp]:
shows "symp (≈⇩v)"
unfolding symp_def complex_cvec_eq_def
by safe (rule_tac x="1/k" in exI, simp)
lemma complex_eq_cvec_transp [simp]:
shows "transp (≈⇩v)"
unfolding transp_def complex_cvec_eq_def
by safe (rule_tac x="k*ka" in exI, simp)
lemma complex_eq_cvec_equivp [simp]:
shows "equivp (≈⇩v)"
by (auto intro: equivpI)
text ‹Non-zero pairs of complex numbers (also treated as non-zero complex vectors)›
typedef complex_homo_coords = "{v::complex_vec. v ≠ vec_zero}"
by (rule_tac x="(1, 0)" in exI, simp)
setup_lifting type_definition_complex_homo_coords
lift_definition complex_homo_coords_eq :: "complex_homo_coords ⇒ complex_homo_coords ⇒ bool" (infix "≈" 50) is complex_cvec_eq
done
lemma complex_homo_coords_eq_reflp [simp]:
shows "reflp (≈)"
using complex_eq_cvec_reflp
unfolding reflp_def
by transfer blast
lemma complex_homo_coords_eq_symp [simp]:
shows "symp (≈)"
using complex_eq_cvec_symp
unfolding symp_def
by transfer blast
lemma complex_homo_coords_eq_transp [simp]:
shows "transp (≈)"
using complex_eq_cvec_transp
unfolding transp_def
by transfer blast
lemma complex_homo_coords_eq_equivp:
shows "equivp (≈)"
by (auto intro: equivpI)
lemma complex_homo_coords_eq_refl [simp]:
shows "z ≈ z"
using complex_homo_coords_eq_reflp
unfolding reflp_def refl_on_def
by blast
lemma complex_homo_coords_eq_sym:
assumes "z1 ≈ z2"
shows "z2 ≈ z1"
using assms complex_homo_coords_eq_symp
unfolding symp_def
by blast
lemma complex_homo_coords_eq_trans:
assumes "z1 ≈ z2" and "z2 ≈ z3"
shows "z1 ≈ z3"
using assms complex_homo_coords_eq_transp
unfolding transp_def
by blast
text ‹Quotient type of homogeneous coordinates›
quotient_type
complex_homo = complex_homo_coords / "complex_homo_coords_eq"
by (rule complex_homo_coords_eq_equivp)
subsection ‹Some characteristic points in $\mathbb{C}P^1$›
text ‹Infinite point›
definition inf_cvec :: "complex_vec" ("∞⇩v") where
[simp]: "inf_cvec = (1, 0)"
lift_definition inf_hcoords :: "complex_homo_coords" ("∞⇩h⇩c") is inf_cvec
by simp
lift_definition inf :: "complex_homo" ("∞⇩h") is inf_hcoords
done
lemma inf_cvec_z2_zero_iff:
assumes "(z1, z2) ≠ vec_zero"
shows "(z1, z2) ≈⇩v ∞⇩v ⟷ z2 = 0"
using assms
by auto
text ‹Zero›
definition zero_cvec :: "complex_vec" ("0⇩v") where
[simp]: "zero_cvec = (0, 1)"
lift_definition zero_hcoords :: "complex_homo_coords" ("0⇩h⇩c") is zero_cvec
by simp
lift_definition zero :: "complex_homo" ("0⇩h") is zero_hcoords
done
lemma zero_cvec_z1_zero_iff:
assumes "(z1, z2) ≠ vec_zero"
shows "(z1, z2) ≈⇩v 0⇩v ⟷ z1 = 0"
using assms
by auto
text ‹One›
definition one_cvec :: "complex_vec" ("1⇩v")where
[simp]: "one_cvec = (1, 1)"
lift_definition one_hcoords :: "complex_homo_coords" ("1⇩h⇩c") is one_cvec
by simp
lift_definition one :: "complex_homo" ("1⇩h") is one_hcoords
done
lemma zero_one_infty_not_equal [simp]:
shows "1⇩h ≠ ∞⇩h" and "0⇩h ≠ ∞⇩h" and "0⇩h ≠ 1⇩h" and "1⇩h ≠ 0⇩h" and "∞⇩h ≠ 0⇩h" and "∞⇩h ≠ 1⇩h"
by (transfer, transfer, simp)+
text ‹Imaginary unit›
definition ii_cvec :: "complex_vec" ("ii⇩v") where
[simp]: "ii_cvec = (𝗂, 1)"
lift_definition ii_hcoords :: "complex_homo_coords" ("ii⇩h⇩c") is ii_cvec
by simp
lift_definition ii :: "complex_homo" ("ii⇩h") is ii_hcoords
done
lemma ex_3_different_points:
fixes z::complex_homo
shows "∃ z1 z2. z ≠ z1 ∧ z1 ≠ z2 ∧ z ≠ z2"
proof (cases "z ≠ 0⇩h ∧ z ≠ 1⇩h")
case True
thus ?thesis
by (rule_tac x="0⇩h" in exI, rule_tac x="1⇩h" in exI, auto)
next
case False
hence "z = 0⇩h ∨ z = 1⇩h"
by simp
thus ?thesis
proof
assume "z = 0⇩h"
thus ?thesis
by (rule_tac x="∞⇩h" in exI, rule_tac x="1⇩h" in exI, auto)
next
assume "z = 1⇩h"
thus ?thesis
by (rule_tac x="∞⇩h" in exI, rule_tac x="0⇩h" in exI, auto)
qed
qed
subsection ‹Connection to ordinary complex plane $\mathbb{C}$›
text ‹Conversion from complex›
definition of_complex_cvec :: "complex ⇒ complex_vec" where
[simp]: "of_complex_cvec z = (z, 1)"
lift_definition of_complex_hcoords :: "complex ⇒ complex_homo_coords" is of_complex_cvec
by simp
lift_definition of_complex :: "complex ⇒ complex_homo" is of_complex_hcoords
done
lemma of_complex_inj:
assumes "of_complex x = of_complex y"
shows "x = y"
using assms
by (transfer, transfer, simp)
lemma of_complex_image_inj:
assumes "of_complex ` A = of_complex ` B"
shows "A = B"
using assms
using of_complex_inj
by auto
lemma of_complex_not_inf [simp]:
shows "of_complex x ≠ ∞⇩h"
by (transfer, transfer, simp)
lemma inf_not_of_complex [simp]:
shows "∞⇩h ≠ of_complex x"
by (transfer, transfer, simp)
lemma inf_or_of_complex:
shows "z = ∞⇩h ∨ (∃ x. z = of_complex x)"
proof (transfer, transfer)
fix z :: complex_vec
obtain z1 z2 where *: "z = (z1, z2)"
by (cases z) auto
assume "z ≠ vec_zero"
thus "z ≈⇩v ∞⇩v ∨ (∃x. z ≈⇩v of_complex_cvec x)"
using *
by (cases "z2 = 0", auto)
qed
lemma of_complex_zero [simp]:
shows "of_complex 0 = 0⇩h"
by (transfer, transfer, simp)
lemma of_complex_one [simp]:
shows "of_complex 1 = 1⇩h"
by (transfer, transfer, simp)
lemma of_complex_ii [simp]:
shows "of_complex 𝗂 = ii⇩h"
by (transfer, transfer, simp)
lemma of_complex_zero_iff [simp]:
shows "of_complex x = 0⇩h ⟷ x = 0"
by (subst of_complex_zero[symmetric]) (auto simp add: of_complex_inj)
lemma of_complex_one_iff [simp]:
shows "of_complex x = 1⇩h ⟷ x = 1"
by (subst of_complex_one[symmetric]) (auto simp add: of_complex_inj)
lemma of_complex_ii_iff [simp]:
shows "of_complex x = ii⇩h ⟷ x = 𝗂"
by (subst of_complex_ii[symmetric]) (auto simp add: of_complex_inj)
text ‹Conversion to complex›
definition to_complex_cvec :: "complex_vec ⇒ complex" where
[simp]: "to_complex_cvec z = (let (z1, z2) = z in z1/z2)"
lift_definition to_complex_homo_coords :: "complex_homo_coords ⇒ complex" is to_complex_cvec
done
lift_definition to_complex :: "complex_homo ⇒ complex" is to_complex_homo_coords
proof-
fix z w
assume "z ≈ w"
thus "to_complex_homo_coords z = to_complex_homo_coords w"
by transfer auto
qed
lemma to_complex_of_complex [simp]:
shows "to_complex (of_complex z) = z"
by (transfer, transfer, simp)
lemma of_complex_to_complex [simp]:
assumes "z ≠ ∞⇩h"
shows "(of_complex (to_complex z)) = z"
using assms
proof (transfer, transfer)
fix z :: complex_vec
obtain z1 z2 where *: "z = (z1, z2)"
by (cases z, auto)
assume "z ≠ vec_zero" "¬ z ≈⇩v ∞⇩v"
hence "z2 ≠ 0"
using *
by (simp, erule_tac x="1/z1" in allE, auto)
thus "(of_complex_cvec (to_complex_cvec z)) ≈⇩v z"
using *
by simp
qed
lemma to_complex_zero_zero [simp]:
shows "to_complex 0⇩h = 0"
by (metis of_complex_zero to_complex_of_complex)
lemma to_complex_one_one [simp]:
shows "to_complex 1⇩h = 1"
by (metis of_complex_one to_complex_of_complex)
lemma to_complex_img_one [simp]:
shows "to_complex ii⇩h = 𝗂"
by (metis of_complex_ii to_complex_of_complex)
subsection ‹Arithmetic operations›
text ‹Due to the requirement of HOL that all functions are total, we could not define the function
only for the well-defined cases, and in the lifting proofs we must also handle the ill-defined
cases. For example, $\infty_h +_h \infty_h$ is ill-defined, but we must define it, so we define it
arbitrarily to be $\infty_h$.›
subsubsection ‹Addition›
text ‹$\infty_h\ +_h\ \infty_h$ is ill-defined. Since functions must be total, for formal reasons we
define it arbitrarily to be $\infty_h$.›
definition add_cvec :: "complex_vec ⇒ complex_vec ⇒ complex_vec" (infixl "+⇩v" 60) where
[simp]: "add_cvec z w = (let (z1, z2) = z; (w1, w2) = w
in if z2 ≠ 0 ∨ w2 ≠ 0 then
(z1*w2 + w1*z2, z2*w2)
else
(1, 0))"
lift_definition add_hcoords :: "complex_homo_coords ⇒ complex_homo_coords ⇒ complex_homo_coords" (infixl "+⇩h⇩c" 60) is add_cvec
by (auto split: if_split_asm)
lift_definition add :: "complex_homo ⇒ complex_homo ⇒ complex_homo" (infixl "+⇩h" 60) is add_hcoords
proof transfer
fix z w z' w' :: complex_vec
obtain z1 z2 w1 w2 z'1 z'2 w'1 w'2 where
*: "z = (z1, z2)" "w = (w1, w2)" "z' = (z'1, z'2)" "w' = (w'1, w'2)"
by (cases z, auto, cases w, auto, cases z', auto, cases w', auto)
assume **:
"z ≠ vec_zero" "w ≠ vec_zero" "z ≈⇩v z'"
"z' ≠ vec_zero" "w' ≠ vec_zero" "w ≈⇩v w'"
show "z +⇩v w ≈⇩v z' +⇩v w'"
proof (cases "z2 ≠ 0 ∨ w2 ≠ 0")
case True
hence "z'2 ≠ 0 ∨ w'2 ≠ 0"
using * **
by auto
show ?thesis
using ‹z2 ≠ 0 ∨ w2 ≠ 0› ‹z'2 ≠ 0 ∨ w'2 ≠ 0›
using * **
by simp ((erule exE)+, rule_tac x="k*ka" in exI, simp add: field_simps)
next
case False
hence "z'2 = 0 ∨ w'2 = 0"
using * **
by auto
show ?thesis
using ‹¬ (z2 ≠ 0 ∨ w2 ≠ 0)› ‹z'2 = 0 ∨ w'2 = 0›
using * **
by auto
qed
qed
lemma add_commute:
shows "z +⇩h w = w +⇩h z"
apply (transfer, transfer)
unfolding complex_cvec_eq_def
by (rule_tac x="1" in exI, auto split: if_split_asm)
lemma add_zero_right [simp]:
shows "z +⇩h 0⇩h = z"
by (transfer, transfer, force)
lemma add_zero_left [simp]:
shows "0⇩h +⇩h z = z"
by (subst add_commute) simp
lemma of_complex_add_of_complex [simp]:
shows "(of_complex x) +⇩h (of_complex y) = of_complex (x + y)"
by (transfer, transfer, simp)
lemma of_complex_add_inf [simp]:
shows "(of_complex x) +⇩h ∞⇩h = ∞⇩h"
by (transfer, transfer, simp)
lemma inf_add_of_complex [simp]:
shows "∞⇩h +⇩h (of_complex x) = ∞⇩h"
by (subst add_commute) simp
lemma inf_add_right:
assumes "z ≠ ∞⇩h"
shows "z +⇩h ∞⇩h = ∞⇩h"
using assms
using inf_or_of_complex[of z]
by auto
lemma inf_add_left:
assumes "z ≠ ∞⇩h"
shows "∞⇩h +⇩h z = ∞⇩h"
using assms
by (subst add_commute) (rule inf_add_right, simp)
text ‹This is ill-defined, but holds by our definition›
lemma inf_add_inf:
shows "∞⇩h +⇩h ∞⇩h = ∞⇩h"
by (transfer, transfer, simp)
subsubsection ‹Unary minus›
definition uminus_cvec :: "complex_vec ⇒ complex_vec" ("~⇩v") where
[simp]: "~⇩v z = (let (z1, z2) = z in (-z1, z2))"
lift_definition uminus_hcoords :: "complex_homo_coords ⇒ complex_homo_coords" ("~⇩h⇩c") is uminus_cvec
by auto
lift_definition uminus :: "complex_homo ⇒ complex_homo" ("~⇩h") is uminus_hcoords
by transfer auto
lemma uminus_of_complex [simp]:
shows "~⇩h (of_complex z) = of_complex (-z)"
by (transfer, transfer, simp)
lemma uminus_zero [simp]:
shows "~⇩h 0⇩h = 0⇩h"
by (transfer, transfer, simp)
lemma uminus_inf [simp]:
shows "~⇩h ∞⇩h = ∞⇩h"
apply (transfer, transfer)
unfolding complex_cvec_eq_def
by (rule_tac x="-1" in exI, simp)
lemma uminus_inf_iff:
shows "~⇩h z = ∞⇩h ⟷ z = ∞⇩h"
apply (transfer, transfer)
by auto (rule_tac x="-1/a" in exI, auto)
lemma uminus_id_iff:
shows "~⇩h z = z ⟷ z = 0⇩h ∨ z = ∞⇩h"
apply (transfer, transfer)
apply auto
apply (erule_tac x="1/a" in allE, simp)
apply (rule_tac x="-1" in exI, simp)
done
subsubsection ‹Subtraction›
text ‹Operation $\infty_h\ -_h\ \infty_h$ is ill-defined, but we define it arbitrarily to $0_h$. It breaks the connection between
subtraction with addition and unary minus, but seems more intuitive.›
definition sub :: "complex_homo ⇒ complex_homo ⇒ complex_homo" (infixl "-⇩h" 60) where
"z -⇩h w = (if z = ∞⇩h ∧ w = ∞⇩h then 0⇩h else z +⇩h (~⇩h w))"
lemma of_complex_sub_of_complex [simp]:
shows "(of_complex x) -⇩h (of_complex y) = of_complex (x - y)"
unfolding sub_def
by simp
lemma zero_sub_right[simp]:
shows "z -⇩h 0⇩h = z"
unfolding sub_def
by simp
lemma zero_sub_left[simp]:
shows "0⇩h -⇩h of_complex x = of_complex (-x)"
by (subst of_complex_zero[symmetric], simp del: of_complex_zero)
lemma zero_sub_one[simp]:
shows "0⇩h -⇩h 1⇩h = of_complex (-1)"
by (metis of_complex_one zero_sub_left)
lemma of_complex_sub_one [simp]:
shows "of_complex x -⇩h 1⇩h = of_complex (x - 1)"
by (metis of_complex_one of_complex_sub_of_complex)
lemma sub_eq_zero [simp]:
assumes "z ≠ ∞⇩h"
shows "z -⇩h z = 0⇩h"
using assms
using inf_or_of_complex[of z]
by auto
lemma sub_eq_zero_iff:
assumes "z ≠ ∞⇩h ∨ w ≠ ∞⇩h"
shows "z -⇩h w = 0⇩h ⟷ z = w"
proof
assume "z -⇩h w = 0⇩h"
thus "z = w"
using assms
unfolding sub_def
proof (transfer, transfer)
fix z w :: complex_vec
obtain z1 z2 w1 w2 where *: "z = (z1, z2)" "w = (w1, w2)"
by (cases z, auto, cases w, auto)
assume "z ≠ vec_zero" "w ≠ vec_zero" "¬ z ≈⇩v ∞⇩v ∨ ¬ w ≈⇩v ∞⇩v" and
**: "(if z ≈⇩v ∞⇩v ∧ w ≈⇩v ∞⇩v then 0⇩v else z +⇩v ~⇩v w) ≈⇩v 0⇩v"
have "z2 ≠ 0 ∨ w2 ≠ 0"
using * ‹¬ z ≈⇩v ∞⇩v ∨ ¬ w ≈⇩v ∞⇩v› ‹z ≠ vec_zero› ‹w ≠ vec_zero›
apply auto
apply (erule_tac x="1/z1" in allE, simp)
apply (erule_tac x="1/w1" in allE, simp)
done
thus "z ≈⇩v w"
using * **
by simp (rule_tac x="w2/z2" in exI, auto simp add: field_simps)
qed
next
assume "z = w"
thus "z -⇩h w = 0⇩h"
using sub_eq_zero[of z] assms
by auto
qed
lemma inf_sub_left [simp]:
assumes "z ≠ ∞⇩h"
shows "∞⇩h -⇩h z = ∞⇩h"
using assms
using uminus_inf_iff
using inf_or_of_complex
unfolding sub_def
by force
lemma inf_sub_right [simp]:
assumes "z ≠ ∞⇩h"
shows "z -⇩h ∞⇩h = ∞⇩h"
using assms
using inf_or_of_complex
unfolding sub_def
by force
text ‹This is ill-defined, but holds by our definition›
lemma inf_sub_inf:
shows "∞⇩h -⇩h ∞⇩h = 0⇩h"
unfolding sub_def
by simp
lemma sub_noteq_inf:
assumes "z ≠ ∞⇩h" and "w ≠ ∞⇩h"
shows "z -⇩h w ≠ ∞⇩h"
using assms
using inf_or_of_complex[of z]
using inf_or_of_complex[of w]
using inf_or_of_complex[of "z -⇩h w"]
using of_complex_sub_of_complex
by auto
lemma sub_eq_inf:
assumes "z -⇩h w = ∞⇩h"
shows "z = ∞⇩h ∨ w = ∞⇩h"
using assms sub_noteq_inf
by blast
subsubsection ‹Multiplication›
text ‹Operations $0_h \cdot_h \infty_h$ and $\infty_h \cdot_h 0_h$ are ill defined. Since all
functions must be total, for formal reasons we define it arbitrarily to be $1_h$.›
definition mult_cvec :: "complex_vec ⇒ complex_vec ⇒ complex_vec" (infixl "*⇩v" 70) where
[simp]: "z *⇩v w = (let (z1, z2) = z; (w1, w2) = w
in if (z1 = 0 ∧ w2 = 0) ∨ (w1 = 0 ∧ z2 = 0) then
(1, 1)
else
(z1*w1, z2*w2))"
lift_definition mult_hcoords :: "complex_homo_coords ⇒ complex_homo_coords ⇒ complex_homo_coords" (infixl "*⇩h⇩c" 70) is mult_cvec
by (auto split: if_split_asm)
lift_definition mult :: "complex_homo ⇒ complex_homo ⇒ complex_homo" (infixl "*⇩h" 70) is mult_hcoords
proof transfer
fix z w z' w' :: complex_vec
obtain z1 z2 w1 w2 z'1 z'2 w'1 w'2 where
*: "z = (z1, z2)" "w = (w1, w2)" "z' = (z'1, z'2)" "w' = (w'1, w'2)"
by (cases z, auto, cases w, auto, cases z', auto, cases w', auto)
assume **:
"z ≠ vec_zero" "w ≠ vec_zero" "z ≈⇩v z'"
"z' ≠ vec_zero" "w' ≠ vec_zero" "w ≈⇩v w'"
show "z *⇩v w ≈⇩v z' *⇩v w'"
proof (cases "(z1 = 0 ∧ w2 = 0) ∨ (w1 = 0 ∧ z2 = 0)")
case True
hence "(z'1 = 0 ∧ w'2 = 0) ∨ (w'1 = 0 ∧ z'2 = 0)"
using * **
by auto
show ?thesis
using ‹(z1 = 0 ∧ w2 = 0) ∨ (w1 = 0 ∧ z2 = 0)› ‹(z'1 = 0 ∧ w'2 = 0) ∨ (w'1 = 0 ∧ z'2 = 0)›
using * **
by simp
next
case False
hence "¬((z'1 = 0 ∧ w'2 = 0) ∨ (w'1 = 0 ∧ z'2 = 0))"
using * **
by auto
hence ***: "z *⇩v w = (z1*w1, z2*w2)" "z' *⇩v w' = (z'1*w'1, z'2*w'2)"
using ‹¬((z1 = 0 ∧ w2 = 0) ∨ (w1 = 0 ∧ z2 = 0))› ‹¬((z'1 = 0 ∧ w'2 = 0) ∨ (w'1 = 0 ∧ z'2 = 0))›
using *
by auto
show ?thesis
apply (subst ***)+
using * **
by simp ((erule exE)+, rule_tac x="k*ka" in exI, simp)
qed
qed
lemma of_complex_mult_of_complex [simp]:
shows "(of_complex z1) *⇩h (of_complex z2) = of_complex (z1 * z2)"
by (transfer, transfer, simp)
lemma mult_commute:
shows "z1 *⇩h z2 = z2 *⇩h z1"
apply (transfer, transfer)
unfolding complex_cvec_eq_def
by (rule_tac x="1" in exI, auto split: if_split_asm)
lemma mult_zero_left [simp]:
assumes "z ≠ ∞⇩h"
shows "0⇩h *⇩h z = 0⇩h"
using assms
proof (transfer, transfer)
fix z :: complex_vec
obtain z1 z2 where *: "z = (z1, z2)"
by (cases z, auto)
assume "z ≠ vec_zero" "¬ (z ≈⇩v ∞⇩v)"
hence "z2 ≠ 0"
using *
by force
thus "0⇩v *⇩v z ≈⇩v 0⇩v"
using *
by simp
qed
lemma mult_zero_right [simp]:
assumes "z ≠ ∞⇩h"
shows "z *⇩h 0⇩h = 0⇩h"
using mult_zero_left[OF assms]
by (simp add: mult_commute)
lemma mult_inf_right [simp]:
assumes "z ≠ 0⇩h"
shows "z *⇩h ∞⇩h = ∞⇩h"
using assms
proof (transfer, transfer)
fix z :: complex_vec
obtain z1 z2 where *: "z = (z1, z2)"
by (cases z, auto)
assume "z ≠ vec_zero" "¬ (z ≈⇩v 0⇩v)"
hence "z1 ≠ 0"
using *
by force
thus "z *⇩v ∞⇩v ≈⇩v ∞⇩v"
using *
by simp
qed
lemma mult_inf_left [simp]:
assumes "z ≠ 0⇩h"
shows "∞⇩h *⇩h z = ∞⇩h"
using mult_inf_right[OF assms]
by (simp add: mult_commute)
lemma mult_one_left [simp]:
shows "1⇩h *⇩h z = z"
by (transfer, transfer, force)
lemma mult_one_right [simp]:
shows "z *⇩h 1⇩h = z"
using mult_one_left[of z]
by (simp add: mult_commute)
text ‹This is ill-defined, but holds by our definition›
lemma inf_mult_zero:
shows "∞⇩h *⇩h 0⇩h = 1⇩h"
by (transfer, transfer, simp)
lemma zero_mult_inf:
shows "0⇩h *⇩h ∞⇩h = 1⇩h"
by (transfer, transfer, simp)
lemma mult_eq_inf:
assumes "z *⇩h w = ∞⇩h"
shows "z = ∞⇩h ∨ w = ∞⇩h"
using assms
using inf_or_of_complex[of z]
using inf_or_of_complex[of w]
using inf_or_of_complex[of "z *⇩h w"]
using of_complex_mult_of_complex
by auto
lemma mult_noteq_inf:
assumes "z ≠ ∞⇩h" and "w ≠ ∞⇩h"
shows "z *⇩h w ≠ ∞⇩h"
using assms mult_eq_inf
by blast
subsubsection ‹Reciprocal›
definition reciprocal_cvec :: "complex_vec ⇒ complex_vec" where
[simp]: "reciprocal_cvec z = (let (z1, z2) = z in (z2, z1))"
lift_definition reciprocal_hcoords :: "complex_homo_coords ⇒ complex_homo_coords" is reciprocal_cvec
by auto
lift_definition reciprocal :: "complex_homo ⇒ complex_homo" is reciprocal_hcoords
by transfer auto
lemma reciprocal_involution [simp]: "reciprocal (reciprocal z) = z"
by (transfer, transfer, auto)
lemma reciprocal_zero [simp]: "reciprocal 0⇩h = ∞⇩h"
by (transfer, transfer, simp)
lemma reciprocal_inf [simp]: "reciprocal ∞⇩h = 0⇩h"
by (transfer, transfer, simp)
lemma reciprocal_one [simp]: "reciprocal 1⇩h = 1⇩h"
by (transfer, transfer, simp)
lemma reciprocal_inf_iff [iff]: "reciprocal z = ∞⇩h ⟷ z = 0⇩h"
by (transfer, transfer, auto)
lemma reciprocal_zero_iff [iff]: "reciprocal z = 0⇩h ⟷ z = ∞⇩h"
by (transfer, transfer, auto)
lemma reciprocal_of_complex [simp]:
assumes "z ≠ 0"
shows "reciprocal (of_complex z) = of_complex (1 / z)"
using assms
by (transfer, transfer, simp)
lemma reciprocal_real:
assumes "is_real (to_complex z)" and "z ≠ 0⇩h" and "z ≠ ∞⇩h"
shows "Re (to_complex (reciprocal z)) = 1 / Re (to_complex z)"
proof-
obtain c where "z = of_complex c" "c ≠ 0" "is_real c"
using assms inf_or_of_complex[of z]
by auto
thus ?thesis
by (simp add: Re_divide_real)
qed
lemma reciprocal_id_iff:
shows "reciprocal z = z ⟷ z = of_complex 1 ∨ z = of_complex (-1)"
proof (cases "z = 0⇩h")
case True
thus ?thesis
by (metis inf_not_of_complex of_complex_zero_iff reciprocal_inf_iff zero_neq_neg_one zero_neq_one)
next
case False
thus ?thesis
using inf_or_of_complex[of z]
by (smt complex_sqrt_1 of_complex_zero_iff reciprocal_inf_iff reciprocal_of_complex to_complex_of_complex)
qed
subsubsection ‹Division›
text ‹Operations $0_h :_h 0_h$ and $\infty_h :_h \infty_h$ are ill-defined. For formal reasons they
are defined to be $1_h$ (by the definition of multiplication).›
definition divide :: "complex_homo ⇒ complex_homo ⇒ complex_homo" (infixl ":⇩h" 70) where
"x :⇩h y = x *⇩h (reciprocal y)"
lemma divide_zero_right [simp]:
assumes "z ≠ 0⇩h"
shows "z :⇩h 0⇩h = ∞⇩h"
using assms
unfolding divide_def
by simp
lemma divide_zero_left [simp]:
assumes "z ≠ 0⇩h"
shows "0⇩h :⇩h z = 0⇩h"
using assms
unfolding divide_def
by simp
lemma divide_inf_right [simp]:
assumes "z ≠ ∞⇩h"
shows "z :⇩h ∞⇩h = 0⇩h"
using assms
unfolding divide_def
by simp
lemma divide_inf_left [simp]:
assumes "z ≠ ∞⇩h"
shows "∞⇩h :⇩h z = ∞⇩h"
using assms reciprocal_zero_iff[of z] mult_inf_left
unfolding divide_def
by simp
lemma divide_eq_inf:
assumes "z :⇩h w = ∞⇩h"
shows "z = ∞⇩h ∨ w = 0⇩h"
using assms
using reciprocal_inf_iff[of w] mult_eq_inf
unfolding divide_def
by auto
lemma inf_divide_zero [simp]:
shows "∞⇩h :⇩h 0⇩h = ∞⇩h"
unfolding divide_def
by (transfer, simp)
lemma zero_divide_inf [simp]:
shows "0⇩h :⇩h ∞⇩h = 0⇩h"
unfolding divide_def
by (transfer, simp)
lemma divide_one_right [simp]:
shows "z :⇩h 1⇩h = z"
unfolding divide_def
by simp
lemma of_complex_divide_of_complex [simp]:
assumes "z2 ≠ 0"
shows "(of_complex z1) :⇩h (of_complex z2) = of_complex (z1 / z2)"
using assms
unfolding divide_def
apply transfer
apply transfer
by (simp, rule_tac x="1/z2" in exI, simp)
lemma one_div_of_complex [simp]:
assumes "x ≠ 0"
shows "1⇩h :⇩h of_complex x = of_complex (1 / x)"
using assms
unfolding divide_def
by simp
text ‹ This is ill-defined, but holds by our definition›
lemma inf_divide_inf:
shows "∞⇩h :⇩h ∞⇩h = 1⇩h"
unfolding divide_def
by (simp add: inf_mult_zero)
text ‹ This is ill-defined, but holds by our definition›
lemma zero_divide_zero:
shows "0⇩h :⇩h 0⇩h = 1⇩h"
unfolding divide_def
by (simp add: zero_mult_inf)
subsubsection ‹Conjugate›
definition conjugate_cvec :: "complex_vec ⇒ complex_vec" where
[simp]: "conjugate_cvec z = vec_cnj z"
lift_definition conjugate_hcoords :: "complex_homo_coords ⇒ complex_homo_coords" is conjugate_cvec
by (auto simp add: vec_cnj_def)
lift_definition conjugate :: "complex_homo ⇒ complex_homo" is conjugate_hcoords
by transfer (auto simp add: vec_cnj_def)
lemma conjugate_involution [simp]:
shows "conjugate (conjugate z) = z"
by (transfer, transfer, auto)
lemma conjugate_conjugate_comp [simp]:
shows "conjugate ∘ conjugate = id"
by (rule ext, simp)
lemma inv_conjugate [simp]:
shows "inv conjugate = conjugate"
using inv_unique_comp[of conjugate conjugate]
by simp
lemma conjugate_of_complex [simp]:
shows "conjugate (of_complex z) = of_complex (cnj z)"
by (transfer, transfer, simp add: vec_cnj_def)
lemma conjugate_inf [simp]:
shows "conjugate ∞⇩h = ∞⇩h"
by (transfer, transfer, simp add: vec_cnj_def)
lemma conjugate_zero [simp]:
shows "conjugate 0⇩h = 0⇩h"
by (transfer, transfer, simp add: vec_cnj_def)
lemma conjugate_one [simp]:
shows "conjugate 1⇩h = 1⇩h"
by (transfer, transfer, simp add: vec_cnj_def)
lemma conjugate_inj:
assumes "conjugate x = conjugate y"
shows "x = y"
using assms
using conjugate_involution[of x] conjugate_involution[of y]
by metis
lemma bij_conjugate [simp]:
shows "bij conjugate"
unfolding bij_def inj_on_def
proof auto
fix x y
assume "conjugate x = conjugate y"
thus "x = y"
by (simp add: conjugate_inj)
next
fix x
show "x ∈ range conjugate"
by (metis conjugate_involution range_eqI)
qed
lemma conjugate_id_iff:
shows "conjugate a = a ⟷ is_real (to_complex a) ∨ a = ∞⇩h"
using inf_or_of_complex[of a]
by (metis conjugate_inf conjugate_of_complex eq_cnj_iff_real to_complex_of_complex)
subsubsection ‹Inversion›
text ‹Geometric inversion wrt. the unit circle›
definition inversion where
"inversion = conjugate ∘ reciprocal"
lemma inversion_sym:
shows "inversion = reciprocal ∘ conjugate"
unfolding inversion_def
apply (rule ext, simp)
apply transfer
apply transfer
apply (auto simp add: vec_cnj_def)
using one_neq_zero
by blast+
lemma inversion_involution [simp]:
shows "inversion (inversion z) = z"
proof-
have *: "conjugate ∘ reciprocal = reciprocal ∘ conjugate"
using inversion_sym
by (simp add: inversion_def)
show ?thesis
unfolding inversion_def
by (subst *) simp
qed
lemma inversion_inversion_id [simp]:
shows "inversion ∘ inversion = id"
by (rule ext, simp)
lemma inversion_zero [simp]:
shows "inversion 0⇩h = ∞⇩h"
by (simp add: inversion_def)
lemma inversion_infty [simp]:
shows "inversion ∞⇩h = 0⇩h"
by (simp add: inversion_def)
lemma inversion_of_complex [simp]:
assumes "z ≠ 0"
shows "inversion (of_complex z) = of_complex (1 / cnj z)"
using assms
by (simp add: inversion_def)
lemma is_real_inversion:
assumes "is_real x" and "x ≠ 0"
shows "is_real (to_complex (inversion (of_complex x)))"
using assms eq_cnj_iff_real[of x]
by simp
lemma inversion_id_iff:
shows "a = inversion a ⟷ a ≠ ∞⇩h ∧ (to_complex a) * cnj (to_complex a) = 1" (is "?lhs = ?rhs")
proof
assume "a = inversion a"
thus ?rhs
unfolding inversion_def
using inf_or_of_complex[of a]
by (metis (full_types) comp_apply complex_cnj_cancel_iff complex_cnj_zero inversion_def inversion_infty inversion_of_complex inversion_sym nonzero_eq_divide_eq of_complex_zero reciprocal_zero to_complex_of_complex zero_one_infty_not_equal(5))
next
assume ?rhs
thus ?lhs
using inf_or_of_complex[of a]
by (metis inversion_of_complex mult_not_zero nonzero_mult_div_cancel_right one_neq_zero to_complex_of_complex)
qed
subsection ‹Ratio and cross-ratio›
subsubsection ‹Ratio›
text ‹Ratio of points $z$, $v$ and $w$ is usually defined as
$\frac{z-v}{z-w}$. Our definition introduces it in homogeneous
coordinates. It is well-defined if $z_1 \neq z_2 \vee z_1 \neq z_3$ and $z_1 \neq \infty_h$ and
$z_2 \neq \infty_h \vee z_3 \neq \infty_h$›
definition ratio :: "complex_homo ⇒ complex_homo ⇒ complex_homo ⇒ complex_homo" where
"ratio za zb zc = (za -⇩h zb) :⇩h (za -⇩h zc)"
text ‹This is ill-defined, but holds by our definition›
lemma
assumes "zb ≠ ∞⇩h" and "zc ≠ ∞⇩h"
shows "ratio ∞⇩h zb zc = 1⇩h"
using assms
using inf_sub_left[OF assms(1)]
using inf_sub_left[OF assms(2)]
unfolding ratio_def
by (simp add: inf_divide_inf)
lemma
assumes "za ≠ ∞⇩h" and "zc ≠ ∞⇩h"
shows "ratio za ∞⇩h zc = ∞⇩h"
using assms
unfolding ratio_def
using inf_sub_right[OF assms(1)]
using sub_noteq_inf[OF assms]
using divide_inf_left
by simp
lemma
assumes "za ≠ ∞⇩h" and "zb ≠ ∞⇩h"
shows "ratio za zb ∞⇩h = 0⇩h"
unfolding ratio_def
using sub_noteq_inf[OF assms]
using inf_sub_right[OF assms(1)]
using divide_inf_right
by simp
lemma
assumes "z1 ≠ z2" and "z1 ≠ ∞⇩h"
shows "ratio z1 z2 z1 = ∞⇩h"
using assms
unfolding ratio_def
using divide_zero_right[of "z1 -⇩h z2"]
using sub_eq_zero_iff[of z1 z2]
by simp
subsubsection ‹Cross-ratio›
text ‹The cross-ratio is defined over 4 points $(z, u, v, w)$, usually as
$\frac{(z-u)(v-w)}{(z-w)(v-u)}$. We define it using homogeneous coordinates. Cross ratio is
ill-defined when $z = u \vee v = w$ and $z = w$ and $v = u$ i.e. when 3 points are equal. Since
function must be total, in that case we define it arbitrarily to 1.›
definition cross_ratio_cvec :: "complex_vec ⇒ complex_vec ⇒ complex_vec ⇒ complex_vec ⇒ complex_vec" where
[simp]: "cross_ratio_cvec z u v w =
(let (z', z'') = z;
(u', u'') = u;
(v', v'') = v;
(w', w'') = w;
n1 = z'*u'' - u'*z'';
n2 = v'*w'' - w'*v'';
d1 = z'*w'' - w'*z'';
d2 = v'*u'' - u'*v''
in
if n1 * n2 ≠ 0 ∨ d1 * d2 ≠ 0 then
(n1 * n2, d1 * d2)
else
(1, 1))"
lift_definition cross_ratio_hcoords :: "complex_homo_coords ⇒ complex_homo_coords ⇒ complex_homo_coords ⇒ complex_homo_coords ⇒ complex_homo_coords" is cross_ratio_cvec
by (auto split: if_split_asm)
lift_definition cross_ratio :: "complex_homo ⇒ complex_homo ⇒ complex_homo ⇒ complex_homo ⇒ complex_homo" is cross_ratio_hcoords
proof transfer
fix z u v w z' u' v' w' :: complex_vec
obtain z1 z2 u1 u2 v1 v2 w1 w2 z'1 z'2 u'1 u'2 v'1 v'2 w'1 w'2
where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
"z' = (z'1, z'2)" "u' = (u'1, u'2)" "v' = (v'1, v'2)" "w' = (w'1, w'2)"
by (cases z, auto, cases u, auto, cases v, auto, cases w, auto,
cases z', auto, cases u', auto, cases v', auto, cases w', auto)
let ?n1 = "z1*u2 - u1*z2"
let ?n2 = "v1*w2 - w1*v2"
let ?d1 = "z1*w2 - w1*z2"
let ?d2 = "v1*u2 - u1*v2"
let ?n1' = "z'1*u'2 - u'1*z'2"
let ?n2' = "v'1*w'2 - w'1*v'2"
let ?d1' = "z'1*w'2 - w'1*z'2"
let ?d2' = "v'1*u'2 - u'1*v'2"
assume **:
"z ≠ vec_zero" "u ≠ vec_zero" "v ≠ vec_zero" "w ≠ vec_zero"
"z' ≠ vec_zero" "u' ≠ vec_zero" "v' ≠ vec_zero" "w' ≠ vec_zero"
"z ≈⇩v z'" "v ≈⇩v v'" "u ≈⇩v u'" "w ≈⇩v w'"
show "cross_ratio_cvec z u v w ≈⇩v cross_ratio_cvec z' u' v' w'"
proof (cases "?n1*?n2 ≠ 0 ∨ ?d1*?d2 ≠ 0")
case True
hence "?n1'*?n2' ≠ 0 ∨ ?d1'*?d2' ≠ 0"
using * **
by simp ((erule exE)+, simp)
show ?thesis
using ‹?n1*?n2 ≠ 0 ∨ ?d1*?d2 ≠ 0›
using ‹?n1'*?n2' ≠ 0 ∨ ?d1'*?d2' ≠ 0›
using * **
by simp ((erule exE)+, rule_tac x="k*ka*kb*kc" in exI, simp add: field_simps)
next
case False
hence "¬ (?n1'*?n2' ≠ 0 ∨ ?d1'*?d2' ≠ 0)"
using * **
by simp ((erule exE)+, simp)
show ?thesis
using ‹¬ (?n1*?n2 ≠ 0 ∨ ?d1*?d2 ≠ 0)›
using ‹¬ (?n1'*?n2' ≠ 0 ∨ ?d1'*?d2' ≠ 0)›
using * **
by simp blast
qed
qed
lemma cross_ratio_01inf_id [simp]:
shows "cross_ratio z 0⇩h 1⇩h ∞⇩h = z"
proof (transfer, transfer)
fix z :: complex_vec
obtain z1 z2 where *: "z = (z1, z2)"
by (cases z, auto)
assume "z ≠ vec_zero"
thus "cross_ratio_cvec z 0⇩v 1⇩v ∞⇩v ≈⇩v z"
using *
by simp (rule_tac x="-1" in exI, simp)
qed
lemma cross_ratio_0:
assumes "u ≠ v" and "u ≠ w"
shows "cross_ratio u u v w = 0⇩h"
using assms
proof (transfer, transfer)
fix u v w :: complex_vec
obtain u1 u2 v1 v2 w1 w2
where *: "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
by (cases u, auto, cases v, auto, cases w, auto)
assume "u ≠ vec_zero" "v ≠ vec_zero" "w ≠ vec_zero" "¬ u ≈⇩v v" "¬ u ≈⇩v w"
thus "cross_ratio_cvec u u v w ≈⇩v 0⇩v"
using * complex_cvec_eq_mix[of u1 u2 v1 v2] complex_cvec_eq_mix[of u1 u2 w1 w2]
by (force simp add: mult.commute)
qed
lemma cross_ratio_1:
assumes "u ≠ v" and "v ≠ w"
shows "cross_ratio v u v w = 1⇩h"
using assms
proof (transfer, transfer)
fix u v w :: complex_vec
obtain u1 u2 v1 v2 w1 w2
where *: "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
by (cases u, auto, cases v, auto, cases w, auto)
let ?n1 = "v1*u2 - u1*v2"
let ?n2 = "v1*w2 - w1*v2"
assume "u ≠ vec_zero" "v ≠ vec_zero" "w ≠ vec_zero" "¬ u ≈⇩v v" "¬ v ≈⇩v w"
hence "?n1 ≠ 0 ∧ ?n2 ≠ 0"
using * complex_cvec_eq_mix[of u1 u2 v1 v2] complex_cvec_eq_mix[of v1 v2 w1 w2]
by (auto simp add: field_simps)
thus "cross_ratio_cvec v u v w ≈⇩v 1⇩v"
using *
by simp (rule_tac x="1 / (?n1 * ?n2)" in exI, simp)
qed
lemma cross_ratio_inf:
assumes "u ≠ w" and "v ≠ w"
shows "cross_ratio w u v w = ∞⇩h"
using assms
proof (transfer, transfer)
fix u v w :: complex_vec
obtain u1 u2 v1 v2 w1 w2
where *: "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
by (cases u, auto, cases v, auto, cases w, auto)
let ?n1 = "w1*u2 - u1*w2"
let ?n2 = "v1*w2 - w1*v2"
assume "u ≠ vec_zero" "v ≠ vec_zero" "w ≠ vec_zero" "¬ u ≈⇩v w" "¬ v ≈⇩v w"
hence "?n1 ≠ 0 ∧ ?n2 ≠ 0"
using * complex_cvec_eq_mix[of u1 u2 w1 w2] complex_cvec_eq_mix[of v1 v2 w1 w2]
by (auto simp add: field_simps)
thus "cross_ratio_cvec w u v w ≈⇩v ∞⇩v"
using *
by simp
qed
lemma cross_ratio_0inf:
assumes "y ≠ 0"
shows "cross_ratio (of_complex x) 0⇩h (of_complex y) ∞⇩h = (of_complex (x / y))"
using assms
by (transfer, transfer) (simp, rule_tac x="-1/y" in exI, simp)
lemma cross_ratio_commute_13:
shows "cross_ratio z u v w = reciprocal (cross_ratio v u z w)"
by (transfer, transfer, case_tac z, case_tac u, case_tac v, case_tac w, simp)
lemma cross_ratio_commute_24:
shows "cross_ratio z u v w = reciprocal (cross_ratio z w v u)"
by (transfer, transfer, case_tac z, case_tac u, case_tac v, case_tac w, simp)
lemma cross_ratio_not_inf:
assumes "z ≠ w" and "u ≠ v"
shows "cross_ratio z u v w ≠ ∞⇩h"
using assms
proof (transfer, transfer)
fix z u v w
assume nz: "z ≠ vec_zero" "u ≠ vec_zero" "v ≠ vec_zero" "w ≠ vec_zero"
obtain z1 z2 u1 u2 v1 v2 w1 w2 where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
by (cases z, cases u, cases v, cases w, auto)
obtain x1 x2 where **: "cross_ratio_cvec z u v w = (x1, x2)"
by (cases "cross_ratio_cvec z u v w", auto)
assume "¬ z ≈⇩v w" "¬ u ≈⇩v v"
hence "z1*w2 ≠ z2*w1" "u1*v2 ≠ u2*v1"
using * nz complex_cvec_eq_mix
by blast+
hence "x2 ≠ 0"
using * **
by (auto split: if_split_asm) (simp add: field_simps)
thus "¬ cross_ratio_cvec z u v w ≈⇩v ∞⇩v"
using inf_cvec_z2_zero_iff * **
by simp
qed
lemma cross_ratio_not_zero:
assumes "z ≠ u" and "v ≠ w"
shows "cross_ratio z u v w ≠ 0⇩h"
using assms
proof (transfer, transfer)
fix z u v w
assume nz: "z ≠ vec_zero" "u ≠ vec_zero" "v ≠ vec_zero" "w ≠ vec_zero"
obtain z1 z2 u1 u2 v1 v2 w1 w2 where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
by (cases z, cases u, cases v, cases w, auto)
obtain x1 x2 where **: "cross_ratio_cvec z u v w = (x1, x2)"
by (cases "cross_ratio_cvec z u v w", auto)
assume "¬ z ≈⇩v u" "¬ v ≈⇩v w"
hence "z1*u2 ≠ z2*u1" "v1*w2 ≠ v2*w1"
using * nz complex_cvec_eq_mix
by blast+
hence "x1 ≠ 0"
using * **
by (auto split: if_split_asm)
thus "¬ cross_ratio_cvec z u v w ≈⇩v 0⇩v"
using zero_cvec_z1_zero_iff * **
by simp
qed
lemma cross_ratio_real:
assumes "is_real z" and "is_real u" and "is_real v" and "is_real w"
assumes "z ≠ u ∧ v ≠ w ∨ z ≠ w ∧ u ≠ v"
shows "is_real (to_complex (cross_ratio (of_complex z) (of_complex u) (of_complex v) (of_complex w)))"
using assms
by (transfer, transfer, auto)
lemma cross_ratio:
assumes "(z ≠ u ∧ v ≠ w) ∨ (z ≠ w ∧ u ≠ v)" and
"z ≠ ∞⇩h" and "u ≠ ∞⇩h" and "v ≠ ∞⇩h" and "w ≠ ∞⇩h"
shows "cross_ratio z u v w = ((z -⇩h u) *⇩h (v -⇩h w)) :⇩h ((z -⇩h w) *⇩h (v -⇩h u))"
unfolding sub_def divide_def
using assms
apply transfer
apply simp
apply transfer
proof-
fix z u v w :: complex_vec
obtain z1 z2 u1 u2 v1 v2 w1 w2
where *: "z = (z1, z2)" "u = (u1, u2)" "v = (v1, v2)" "w = (w1, w2)"
by (cases z, auto, cases u, auto, cases v, auto, cases w, auto)
let ?n1 = "z1*u2 - u1*z2"
let ?n2 = "v1*w2 - w1*v2"
let ?d1 = "z1*w2 - w1*z2"
let ?d2 = "v1*u2 - u1*v2"
assume **: "z ≠ vec_zero" "u ≠ vec_zero" "v ≠ vec_zero" "w ≠ vec_zero"
"¬ z ≈⇩v u ∧ ¬ v ≈⇩v w ∨ ¬ z ≈⇩v w ∧ ¬ u ≈⇩v v"
"¬ z ≈⇩v ∞⇩v" "¬ u ≈⇩v ∞⇩v" "¬ v ≈⇩v ∞⇩v" "¬ w ≈⇩v ∞⇩v"
hence ***: "?n1 * ?n2 ≠ 0 ∨ ?d1 * ?d2 ≠ 0"
using *
using complex_cvec_eq_mix[of z1 z2 u1 u2] complex_cvec_eq_mix[of v1 v2 w1 w2]
using complex_cvec_eq_mix[of z1 z2 w1 w2] complex_cvec_eq_mix[of u1 u2 v1 v2]
by (metis eq_iff_diff_eq_0 mult.commute mult_eq_0_iff)
have ****: "z2 ≠ 0" "w2 ≠ 0" "u2 ≠ 0" "v2 ≠ 0"
using * **(1-4) **(6-9)
using inf_cvec_z2_zero_iff[of z1 z2]
using inf_cvec_z2_zero_iff[of u1 u2]
using inf_cvec_z2_zero_iff[of v1 v2]
using inf_cvec_z2_zero_iff[of w1 w2]
by blast+
have "cross_ratio_cvec z u v w = (?n1*?n2, ?d1*?d2)"
using * ***
by simp
moreover
let ?k = "z2*u2*v2*w2"
have "(z +⇩v ~⇩v u) *⇩v (v +⇩v ~⇩v w) *⇩v reciprocal_cvec ((z +⇩v ~⇩v w) *⇩v (v +⇩v ~⇩v u)) = (?k * ?n1 * ?n2, ?k * ?d1 * ?d2)"
using * *** ****
by auto
ultimately
show "cross_ratio_cvec z u v w ≈⇩v
(z +⇩v ~⇩v u) *⇩v (v +⇩v ~⇩v w) *⇩v reciprocal_cvec ((z +⇩v ~⇩v w) *⇩v (v +⇩v ~⇩v u))"
using ****
unfolding complex_cvec_eq_def
by (rule_tac x="?k" in exI) simp
qed
end
Theory Moebius
section ‹Möbius transformations›
text ‹Möbius transformations (also called homographic, linear fractional, or bilinear
transformations) are the fundamental transformations of the extended complex plane. Here they are
introduced algebraically. Each transformation is represented by a regular (non-singular,
non-degenerate) $2\times 2$ matrix that acts linearly on homogeneous coordinates. As proportional
homogeneous coordinates represent same points of $\mathbb{\overline{C}}$, proportional matrices will
represent the same Möbius transformation.›
theory Moebius
imports Homogeneous_Coordinates
begin
subsection ‹Definition of Möbius transformations›
typedef moebius_mat = "{M::complex_mat. mat_det M ≠ 0}"
by (rule_tac x="eye" in exI, simp)
setup_lifting type_definition_moebius_mat
definition moebius_cmat_eq :: "complex_mat ⇒ complex_mat ⇒ bool" where
[simp]: "moebius_cmat_eq A B ⟷ (∃ k::complex. k ≠ 0 ∧ B = k *⇩s⇩m A)"
lift_definition moebius_mat_eq :: "moebius_mat ⇒ moebius_mat ⇒ bool" is moebius_cmat_eq
done
lemma moebius_mat_eq_refl [simp]:
shows "moebius_mat_eq x x"
by transfer simp
quotient_type moebius = moebius_mat / moebius_mat_eq
proof (rule equivpI)
show "reflp moebius_mat_eq"
unfolding reflp_def
by transfer auto
next
show "symp moebius_mat_eq"
unfolding symp_def
by transfer (auto simp add: symp_def, rule_tac x="1/k" in exI, simp)
next
show "transp moebius_mat_eq"
unfolding transp_def
by transfer (auto simp add: transp_def, rule_tac x="ka*k" in exI, simp)
qed
definition mk_moebius_cmat :: "complex ⇒ complex ⇒ complex ⇒ complex ⇒ complex_mat" where
[simp]: "mk_moebius_cmat a b c d =
(let M = (a, b, c, d)
in if mat_det M ≠ 0 then
M
else
eye)"
lift_definition mk_moebius_mat :: "complex ⇒ complex ⇒ complex ⇒ complex ⇒ moebius_mat" is mk_moebius_cmat
by simp
lift_definition mk_moebius :: "complex ⇒ complex ⇒ complex ⇒ complex ⇒ moebius" is mk_moebius_mat
done
lemma ex_mk_moebius:
shows "∃ a b c d. M = mk_moebius a b c d ∧ mat_det (a, b, c, d) ≠ 0"
proof (transfer, transfer)
fix M :: complex_mat
assume "mat_det M ≠ 0"
obtain a b c d where "M = (a, b, c, d)"
by (cases M, auto)
hence "moebius_cmat_eq M (mk_moebius_cmat a b c d) ∧ mat_det (a, b, c, d) ≠ 0"
using ‹mat_det M ≠ 0›
by auto (rule_tac x=1 in exI, simp)
thus "∃a b c d. moebius_cmat_eq M (mk_moebius_cmat a b c d) ∧ mat_det (a, b, c, d) ≠ 0"
by blast
qed
subsection ‹Action on points›
text ‹Möbius transformations are given as the action of Möbius group on the points of the
extended complex plane (in homogeneous coordinates).›
definition moebius_pt_cmat_cvec :: "complex_mat ⇒ complex_vec ⇒ complex_vec" where
[simp]: "moebius_pt_cmat_cvec M z = M *⇩m⇩v z"
lift_definition moebius_pt_mmat_hcoords :: "moebius_mat ⇒ complex_homo_coords ⇒ complex_homo_coords" is moebius_pt_cmat_cvec
by auto algebra+
lift_definition moebius_pt :: "moebius ⇒ complex_homo ⇒ complex_homo" is moebius_pt_mmat_hcoords
proof transfer
fix M M' x x'
assume "moebius_cmat_eq M M'" "x ≈⇩v x'"
thus "moebius_pt_cmat_cvec M x ≈⇩v moebius_pt_cmat_cvec M' x'"
by (cases "M", cases "x", auto simp add: field_simps) (rule_tac x="k*ka" in exI, simp)
qed
lemma bij_moebius_pt [simp]:
shows "bij (moebius_pt M)"
unfolding bij_def inj_on_def surj_def
proof safe
fix x y
assume "moebius_pt M x = moebius_pt M y"
thus "x = y"
proof (transfer, transfer)
fix M x y
assume "mat_det M ≠ 0" "moebius_pt_cmat_cvec M x ≈⇩v moebius_pt_cmat_cvec M y"
thus "x ≈⇩v y"
using mult_sv_mv[of _ M x] mult_mv_inv[of _ M]
unfolding moebius_pt_cmat_cvec_def
by (metis complex_cvec_eq_def)
qed
next
fix y
show "∃x. y = moebius_pt M x"
proof (transfer, transfer)
fix y :: complex_vec and M :: complex_mat
assume *: "y ≠ vec_zero" "mat_det M ≠ 0"
let ?iM = "mat_inv M"
let ?x = "?iM *⇩m⇩v y"
have "?x ≠ vec_zero"
using *
by (metis mat_det_mult mat_eye_r mat_inv_r mult_cancel_right1 mult_mv_nonzero)
moreover
have "y ≈⇩v moebius_pt_cmat_cvec M ?x"
by (simp del: eye_def add: mat_inv_r[OF ‹mat_det M ≠ 0›])
ultimately
show "∃x∈{v. v ≠ vec_zero}. y ≈⇩v moebius_pt_cmat_cvec M x"
by (rule_tac x="?x" in bexI, simp_all)
qed
qed
lemma moebius_pt_eq_I:
assumes "moebius_pt M z1 = moebius_pt M z2"
shows "z1 = z2"
using assms
using bij_moebius_pt[of M]
unfolding bij_def inj_on_def
by blast
lemma moebius_pt_neq_I [simp]:
assumes "z1 ≠ z2"
shows "moebius_pt M z1 ≠ moebius_pt M z2"
using assms
by (auto simp add: moebius_pt_eq_I)
definition is_moebius :: "(complex_homo ⇒ complex_homo) ⇒ bool" where
"is_moebius f ⟷ (∃ M. f = moebius_pt M)"
text ‹In the classic literature Möbius transformations are often expressed in the form
$\frac{az+b}{cz+d}$. The following lemma shows that when restricted to finite points, the action
of Möbius transformations is bilinear.›
lemma moebius_pt_bilinear:
assumes "mat_det (a, b, c, d) ≠ 0"
shows "moebius_pt (mk_moebius a b c d) z =
(if z ≠ ∞⇩h then
((of_complex a) *⇩h z +⇩h (of_complex b)) :⇩h
((of_complex c) *⇩h z +⇩h (of_complex d))
else
(of_complex a) :⇩h
(of_complex c))"
unfolding divide_def
using assms
proof (transfer, transfer)
fix a b c d :: complex and z :: complex_vec
obtain z1 z2 where zz: "z = (z1, z2)"
by (cases z, auto)
assume *: "mat_det (a, b, c, d) ≠ 0" "z ≠ vec_zero"
let ?oc = "of_complex_cvec"
show "moebius_pt_cmat_cvec (mk_moebius_cmat a b c d) z ≈⇩v
(if ¬ z ≈⇩v ∞⇩v
then (?oc a *⇩v z +⇩v ?oc b) *⇩v
reciprocal_cvec (?oc c *⇩v z +⇩v ?oc d)
else ?oc a *⇩v
reciprocal_cvec (?oc c))"
proof (cases "z ≈⇩v ∞⇩v")
case True
thus ?thesis
using zz *
by auto
next
case False
hence "z2 ≠ 0"
using zz inf_cvec_z2_zero_iff ‹z ≠ vec_zero›
by auto
thus ?thesis
using zz * False
using regular_homogenous_system[of a b c d z1 z2]
by auto
qed
qed
subsection ‹Möbius group›
text ‹Möbius elements form a group under composition. This group is called the \emph{projective
general linear group} and denoted by $PGL(2, \mathbb{C})$ (the group $SGL(2, \mathbb{C})$ containing elements
with the determinant $1$ can also be considered).›
text ‹Identity Möbius transformation is represented by the identity matrix.›
definition id_moebius_cmat :: "complex_mat" where
[simp]: "id_moebius_cmat = eye"
lift_definition id_moebius_mmat :: "moebius_mat" is id_moebius_cmat
by simp
lift_definition id_moebius :: "moebius" is id_moebius_mmat
done
lemma moebius_pt_moebius_id [simp]:
shows "moebius_pt id_moebius = id"
unfolding id_def
apply (rule ext, transfer, transfer)
using eye_mv_l
by simp
lemma mk_moeibus_id [simp]:
shows "mk_moebius a 0 0 a = id_moebius"
by (transfer, transfer, simp)
text ‹The inverse Möbius transformation is obtained by taking the inverse representative matrix.›
definition moebius_inv_cmat :: "complex_mat ⇒ complex_mat" where
[simp]: "moebius_inv_cmat M = mat_inv M"
lift_definition moebius_inv_mmat :: "moebius_mat ⇒ moebius_mat" is moebius_inv_cmat
by (simp add: mat_det_inv)
lift_definition moebius_inv :: "moebius ⇒ moebius" is "moebius_inv_mmat"
proof (transfer)
fix x y
assume "moebius_cmat_eq x y"
thus "moebius_cmat_eq (moebius_inv_cmat x) (moebius_inv_cmat y)"
by (auto simp add: mat_inv_mult_sm) (rule_tac x="1/k" in exI, simp)
qed
lemma moebius_inv:
shows "moebius_pt (moebius_inv M) = inv (moebius_pt M)"
proof (rule inv_equality[symmetric])
fix x
show "moebius_pt (moebius_inv M) (moebius_pt M x) = x"
proof (transfer, transfer)
fix M::complex_mat and x::complex_vec
assume "mat_det M ≠ 0" "x ≠ vec_zero"
show "moebius_pt_cmat_cvec (moebius_inv_cmat M) (moebius_pt_cmat_cvec M x) ≈⇩v x"
using eye_mv_l
by (simp add: mat_inv_l[OF ‹mat_det M ≠ 0›])
qed
next
fix y
show "moebius_pt M (moebius_pt (moebius_inv M) y) = y"
proof (transfer, transfer)
fix M::complex_mat and y::complex_vec
assume "mat_det M ≠ 0" "y ≠ vec_zero"
show "moebius_pt_cmat_cvec M (moebius_pt_cmat_cvec (moebius_inv_cmat M) y) ≈⇩v y"
using eye_mv_l
by (simp add: mat_inv_r[OF ‹mat_det M ≠ 0›])
qed
qed
lemma is_moebius_inv [simp]:
assumes "is_moebius m"
shows "is_moebius (inv m)"
using assms
using moebius_inv
unfolding is_moebius_def
by metis
lemma moebius_inv_mk_moebus [simp]:
assumes "mat_det (a, b, c, d) ≠ 0"
shows "moebius_inv (mk_moebius a b c d) =
mk_moebius (d/(a*d-b*c)) (-b/(a*d-b*c)) (-c/(a*d-b*c)) (a/(a*d-b*c))"
using assms
by (transfer, transfer) (auto, rule_tac x=1 in exI, simp_all add: field_simps)
text ‹Composition of Möbius elements is obtained by multiplying their representing matrices.›
definition moebius_comp_cmat :: "complex_mat ⇒ complex_mat ⇒ complex_mat" where
[simp]: "moebius_comp_cmat M1 M2 = M1 *⇩m⇩m M2"
lift_definition moebius_comp_mmat :: "moebius_mat ⇒ moebius_mat ⇒ moebius_mat" is moebius_comp_cmat
by simp
lift_definition moebius_comp :: "moebius ⇒ moebius ⇒ moebius" is moebius_comp_mmat
by transfer (simp, (erule exE)+, rule_tac x="k*ka" in exI, simp add: field_simps)
lemma moebius_comp:
shows "moebius_pt (moebius_comp M1 M2) = moebius_pt M1 ∘ moebius_pt M2"
unfolding comp_def
by (rule ext, transfer, transfer, simp)
lemma moebius_pt_comp [simp]:
shows "moebius_pt (moebius_comp M1 M2) z = moebius_pt M1 (moebius_pt M2 z)"
by (auto simp add: moebius_comp)
lemma is_moebius_comp [simp]:
assumes "is_moebius m1" and "is_moebius m2"
shows "is_moebius (m1 ∘ m2)"
using assms
unfolding is_moebius_def
using moebius_comp
by metis
lemma moebius_comp_mk_moebius [simp]:
assumes "mat_det (a, b, c, d) ≠ 0" and "mat_det (a', b', c', d') ≠ 0"
shows "moebius_comp (mk_moebius a b c d) (mk_moebius a' b' c' d') =
mk_moebius (a * a' + b * c') (a * b' + b * d') (c * a' + d * c') (c * b' + d * d')"
using mat_det_mult[of "(a, b, c, d)" "(a', b', c', d')"]
using assms
by (transfer, transfer) (auto, rule_tac x=1 in exI, simp)
instantiation moebius :: group_add
begin
definition plus_moebius :: "moebius ⇒ moebius ⇒ moebius" where
[simp]: "plus_moebius = moebius_comp"
definition uminus_moebius :: "moebius ⇒ moebius" where
[simp]: "uminus_moebius = moebius_inv"
definition zero_moebius :: "moebius" where
[simp]: "zero_moebius = id_moebius"
definition minus_moebius :: "moebius ⇒ moebius ⇒ moebius" where
[simp]: "minus_moebius A B = A + (-B)"
instance proof
fix a b c :: moebius
show "a + b + c = a + (b + c)"
unfolding plus_moebius_def
proof (transfer, transfer)
fix a b c :: complex_mat
assume "mat_det a ≠ 0" "mat_det b ≠ 0" "mat_det c ≠ 0"
show "moebius_cmat_eq (moebius_comp_cmat (moebius_comp_cmat a b) c) (moebius_comp_cmat a (moebius_comp_cmat b c))"
by simp (rule_tac x="1" in exI, simp add: mult_mm_assoc)
qed
next
fix a :: moebius
show "a + 0 = a"
unfolding plus_moebius_def zero_moebius_def
proof (transfer, transfer)
fix A :: complex_mat
assume "mat_det A ≠ 0"
thus "moebius_cmat_eq (moebius_comp_cmat A id_moebius_cmat) A"
using mat_eye_r
by simp
qed
next
fix a :: moebius
show "0 + a = a"
unfolding plus_moebius_def zero_moebius_def
proof (transfer, transfer)
fix A :: complex_mat
assume "mat_det A ≠ 0"
thus "moebius_cmat_eq (moebius_comp_cmat id_moebius_cmat A) A"
using mat_eye_l
by simp
qed
next
fix a :: moebius
show "- a + a = 0"
unfolding plus_moebius_def uminus_moebius_def zero_moebius_def
proof (transfer, transfer)
fix a :: complex_mat
assume "mat_det a ≠ 0"
thus "moebius_cmat_eq (moebius_comp_cmat (moebius_inv_cmat a) a) id_moebius_cmat"
by (simp add: mat_inv_l)
qed
next
fix a b :: moebius
show "a + - b = a - b"
unfolding minus_moebius_def
by simp
qed
end
text ‹Composition with inverse›
lemma moebius_comp_inv_left [simp]:
shows "moebius_comp (moebius_inv M) M = id_moebius"
by (metis left_minus plus_moebius_def uminus_moebius_def zero_moebius_def)
lemma moebius_comp_inv_right [simp]:
shows "moebius_comp M (moebius_inv M) = id_moebius"
by (metis right_minus plus_moebius_def uminus_moebius_def zero_moebius_def)
lemma moebius_pt_comp_inv_left [simp]:
shows "moebius_pt (moebius_inv M) (moebius_pt M z) = z"
by (subst moebius_pt_comp[symmetric], simp)
lemma moebius_pt_comp_inv_right [simp]:
shows "moebius_pt M (moebius_pt (moebius_inv M) z) = z"
by (subst moebius_pt_comp[symmetric], simp)
lemma moebius_pt_comp_inv_image_left [simp]:
shows "moebius_pt (moebius_inv M) ` moebius_pt M ` A = A"
by force
lemma moebius_pt_comp_inv_image_right [simp]:
shows "moebius_pt M ` moebius_pt (moebius_inv M) ` A = A"
by force
lemma moebius_pt_invert:
assumes "moebius_pt M z1 = z2"
shows "moebius_pt (moebius_inv M) z2 = z1"
using assms[symmetric]
by simp
lemma moebius_pt_moebius_inv_in_set [simp]:
assumes "moebius_pt M z ∈ A"
shows "z ∈ moebius_pt (moebius_inv M) ` A"
using assms
using image_iff
by fastforce
subsection ‹Special kinds of Möbius transformations›
subsubsection ‹Reciprocal (1/z) as a Möbius transformation›
definition moebius_reciprocal :: "moebius" where
"moebius_reciprocal = mk_moebius 0 1 1 0"
lemma moebius_reciprocal [simp]:
shows "moebius_pt moebius_reciprocal = reciprocal"
unfolding moebius_reciprocal_def
by (rule ext, transfer, transfer) (force simp add: split_def)
lemma moebius_reciprocal_inv [simp]:
shows "moebius_inv moebius_reciprocal = moebius_reciprocal"
unfolding moebius_reciprocal_def
by (transfer, transfer) simp
subsubsection ‹Euclidean similarities as a Möbius transform›
text‹Euclidean similarities include Euclidean isometries (translations and rotations) and
dilatations.›
definition moebius_similarity :: "complex ⇒ complex ⇒ moebius" where
"moebius_similarity a b = mk_moebius a b 0 1"
lemma moebius_pt_moebius_similarity [simp]:
assumes "a ≠ 0"
shows "moebius_pt (moebius_similarity a b) z = (of_complex a) *⇩h z +⇩h (of_complex b)"
unfolding moebius_similarity_def
using assms
using mult_inf_right[of "of_complex a"]
by (subst moebius_pt_bilinear, auto)
text ‹Their action is a linear transformation of $\mathbb{C}.$›
lemma moebius_pt_moebius_similarity':
assumes "a ≠ 0"
shows "moebius_pt (moebius_similarity a b) = (λ z. (of_complex a) *⇩h z +⇩h (of_complex b))"
using moebius_pt_moebius_similarity[OF assms, symmetric]
by simp
lemma is_moebius_similarity':
assumes "a ≠ 0⇩h" and "a ≠ ∞⇩h" and "b ≠ ∞⇩h"
shows "(λ z. a *⇩h z +⇩h b) = moebius_pt (moebius_similarity (to_complex a) (to_complex b))"
proof-
obtain ka kb where *: "a = of_complex ka" "ka ≠ 0" "b = of_complex kb"
using assms
using inf_or_of_complex[of a] inf_or_of_complex[of b]
by auto
thus ?thesis
unfolding is_moebius_def
using moebius_pt_moebius_similarity'[of ka kb]
by simp
qed
lemma is_moebius_similarity:
assumes "a ≠ 0⇩h" and "a ≠ ∞⇩h" and "b ≠ ∞⇩h"
shows "is_moebius (λ z. a *⇩h z +⇩h b)"
using is_moebius_similarity'[OF assms]
unfolding is_moebius_def
by auto
text ‹Euclidean similarities form a group.›
lemma moebius_similarity_id [simp]:
shows "moebius_similarity 1 0 = id_moebius"
unfolding moebius_similarity_def
by simp
lemma moebius_similarity_inv [simp]:
assumes "a ≠ 0"
shows "moebius_inv (moebius_similarity a b) = moebius_similarity (1/a) (-b/a)"
using assms
unfolding moebius_similarity_def
by simp
lemma moebius_similarity_uminus [simp]:
assumes "a ≠ 0"
shows "- moebius_similarity a b = moebius_similarity (1/a) (-b/a)"
using assms
by simp
lemma moebius_similarity_comp [simp]:
assumes "a ≠ 0" and "c ≠ 0"
shows "moebius_comp (moebius_similarity a b) (moebius_similarity c d) = moebius_similarity (a*c) (a*d+b)"
using assms
unfolding moebius_similarity_def
by simp
lemma moebius_similarity_plus [simp]:
assumes "a ≠ 0" and "c ≠ 0"
shows "moebius_similarity a b + moebius_similarity c d = moebius_similarity (a*c) (a*d+b)"
using assms
by simp
text ‹Euclidean similarities are the only Möbius group elements such that their action leaves the
$\infty_{h}$ fixed.›
lemma moebius_similarity_inf [simp]:
assumes "a ≠ 0"
shows "moebius_pt (moebius_similarity a b) ∞⇩h = ∞⇩h"
using assms
unfolding moebius_similarity_def
by (transfer, transfer, simp)
lemma moebius_similarity_only_inf_to_inf:
assumes "a ≠ 0" "moebius_pt (moebius_similarity a b) z = ∞⇩h"
shows "z = ∞⇩h"
using assms
using inf_or_of_complex[of z]
by auto
lemma moebius_similarity_inf_iff [simp]:
assumes "a ≠ 0"
shows "moebius_pt (moebius_similarity a b) z = ∞⇩h ⟷ z = ∞⇩h"
using assms
using moebius_similarity_only_inf_to_inf[of a b z]
by auto
lemma inf_fixed_only_moebius_similarity:
assumes "moebius_pt M ∞⇩h = ∞⇩h"
shows "∃ a b. a ≠ 0 ∧ M = moebius_similarity a b"
using assms
unfolding moebius_similarity_def
proof (transfer, transfer)
fix M :: complex_mat
obtain a b c d where MM: "M = (a, b, c, d)"
by (cases M, auto)
assume "mat_det M ≠ 0" "moebius_pt_cmat_cvec M ∞⇩v ≈⇩v ∞⇩v"
hence *: "c = 0" "a ≠ 0 ∧ d ≠ 0"
using MM
by auto
show "∃a b. a ≠ 0 ∧ moebius_cmat_eq M (mk_moebius_cmat a b 0 1)"
proof (rule_tac x="a/d" in exI, rule_tac x="b/d" in exI)
show "a/d ≠ 0 ∧ moebius_cmat_eq M (mk_moebius_cmat (a / d) (b / d) 0 1)"
using MM *
by simp (rule_tac x="1/d" in exI, simp)
qed
qed
text ‹Euclidean similarities include translations, rotations, and dilatations.›
subsubsection ‹Translation›
definition moebius_translation where
"moebius_translation v = moebius_similarity 1 v"
lemma moebius_translation_comp [simp]:
shows "moebius_comp (moebius_translation v1) (moebius_translation v2) = moebius_translation (v1 + v2)"
unfolding moebius_translation_def
by (simp add: field_simps)
lemma moebius_translation_plus [simp]:
shows "(moebius_translation v1) + (moebius_translation v2) = moebius_translation (v1 + v2)"
by simp
lemma moebius_translation_zero [simp]:
shows "moebius_translation 0 = id_moebius"
unfolding moebius_translation_def moebius_similarity_id
by simp
lemma moebius_translation_inv [simp]:
shows "moebius_inv (moebius_translation v1) = moebius_translation (-v1)"
using moebius_translation_comp[of v1 "-v1"] moebius_translation_zero
using minus_unique[of "moebius_translation v1" "moebius_translation (-v1)"]
by simp
lemma moebius_translation_uminus [simp]:
shows "- (moebius_translation v1) = moebius_translation (-v1)"
by simp
lemma moebius_translation_inv_translation [simp]:
shows "moebius_pt (moebius_translation v) (moebius_pt (moebius_translation (-v)) z) = z"
using moebius_translation_inv[symmetric, of v]
by (simp del: moebius_translation_inv)
lemma moebius_inv_translation_translation [simp]:
shows "moebius_pt (moebius_translation (-v)) (moebius_pt (moebius_translation v) z) = z"
using moebius_translation_inv[symmetric, of v]
by (simp del: moebius_translation_inv)
lemma moebius_pt_moebius_translation [simp]:
shows "moebius_pt (moebius_translation v) (of_complex z) = of_complex (z + v)"
unfolding moebius_translation_def
by (simp add: field_simps)
lemma moebius_pt_moebius_translation_inf [simp]:
shows "moebius_pt (moebius_translation v) ∞⇩h = ∞⇩h"
unfolding moebius_translation_def
by simp
subsubsection ‹Rotation›
definition moebius_rotation where
"moebius_rotation φ = moebius_similarity (cis φ) 0"
lemma moebius_rotation_comp [simp]:
shows "moebius_comp (moebius_rotation φ1) (moebius_rotation φ2) = moebius_rotation (φ1 + φ2)"
unfolding moebius_rotation_def
using moebius_similarity_comp[of "cis φ1" "cis φ2" 0 0]
by (simp add: cis_mult)
lemma moebius_rotation_plus [simp]:
shows "(moebius_rotation φ1) + (moebius_rotation φ2) = moebius_rotation (φ1 + φ2)"
by simp
lemma moebius_rotation_zero [simp]:
shows "moebius_rotation 0 = id_moebius"
unfolding moebius_rotation_def
using moebius_similarity_id
by simp
lemma moebius_rotation_inv [simp]:
shows "moebius_inv (moebius_rotation φ) = moebius_rotation (- φ)"
using moebius_rotation_comp[of φ "-φ"] moebius_rotation_zero
using minus_unique[of "moebius_rotation φ" "moebius_rotation (-φ)"]
by simp
lemma moebius_rotation_uminus [simp]:
shows "- (moebius_rotation φ) = moebius_rotation (- φ)"
by simp
lemma moebius_rotation_inv_rotation [simp]:
shows "moebius_pt (moebius_rotation φ) (moebius_pt (moebius_rotation (-φ)) z) = z"
using moebius_rotation_inv[symmetric, of φ]
by (simp del: moebius_rotation_inv)
lemma moebius_inv_rotation_rotation [simp]:
shows "moebius_pt (moebius_rotation (-φ)) (moebius_pt (moebius_rotation φ) z) = z"
using moebius_rotation_inv[symmetric, of φ]
by (simp del: moebius_rotation_inv)
lemma moebius_pt_moebius_rotation [simp]:
shows "moebius_pt (moebius_rotation φ) (of_complex z) = of_complex (cis φ * z)"
unfolding moebius_rotation_def
by simp
lemma moebius_pt_moebius_rotation_inf [simp]:
shows "moebius_pt (moebius_rotation v) ∞⇩h = ∞⇩h"
unfolding moebius_rotation_def
by simp
lemma moebius_pt_rotation_inf_iff [simp]:
shows "moebius_pt (moebius_rotation v) x = ∞⇩h ⟷ x = ∞⇩h"
unfolding moebius_rotation_def
using cis_neq_zero moebius_similarity_only_inf_to_inf
by (simp del: moebius_pt_moebius_similarity)
lemma moebius_pt_moebius_rotation_zero [simp]:
shows "moebius_pt (moebius_rotation φ) 0⇩h = 0⇩h"
unfolding moebius_rotation_def
by simp
lemma moebius_pt_moebius_rotation_zero_iff [simp]:
shows "moebius_pt (moebius_rotation φ) x = 0⇩h ⟷ x = 0⇩h"
using moebius_pt_invert[of "moebius_rotation φ" x "0⇩h"]
by auto
lemma moebius_rotation_preserve_cmod [simp]:
assumes "u ≠ ∞⇩h"
shows "cmod (to_complex (moebius_pt (moebius_rotation φ) u)) = cmod (to_complex u)"
using assms
using inf_or_of_complex[of u]
by (auto simp: norm_mult)
subsubsection ‹Dilatation›
definition moebius_dilatation where
"moebius_dilatation a = moebius_similarity (cor a) 0"
lemma moebius_dilatation_comp [simp]:
assumes "a1 > 0" and "a2 > 0"
shows "moebius_comp (moebius_dilatation a1) (moebius_dilatation a2) = moebius_dilatation (a1 * a2)"
using assms
unfolding moebius_dilatation_def
by simp
lemma moebius_dilatation_plus [simp]:
assumes "a1 > 0" and "a2 > 0"
shows "(moebius_dilatation a1) + (moebius_dilatation a2) = moebius_dilatation (a1 * a2)"
using assms
by simp
lemma moebius_dilatation_zero [simp]:
shows "moebius_dilatation 1 = id_moebius"
unfolding moebius_dilatation_def
using moebius_similarity_id
by simp
lemma moebius_dilatation_inverse [simp]:
assumes "a > 0"
shows "moebius_inv (moebius_dilatation a) = moebius_dilatation (1/a)"
using assms
unfolding moebius_dilatation_def
by simp
lemma moebius_dilatation_uminus [simp]:
assumes "a > 0"
shows "- (moebius_dilatation a) = moebius_dilatation (1/a)"
using assms
by simp
lemma moebius_pt_dilatation [simp]:
assumes "a ≠ 0"
shows "moebius_pt (moebius_dilatation a) (of_complex z) = of_complex (cor a * z)"
using assms
unfolding moebius_dilatation_def
by simp
subsubsection ‹Rotation-dilatation›
definition moebius_rotation_dilatation where
"moebius_rotation_dilatation a = moebius_similarity a 0"
lemma moebius_rotation_dilatation:
assumes "a ≠ 0"
shows "moebius_rotation_dilatation a = moebius_rotation (arg a) + moebius_dilatation (cmod a)"
using assms
unfolding moebius_rotation_dilatation_def moebius_rotation_def moebius_dilatation_def
by simp
subsubsection ‹Conjugate Möbius›
text ‹Conjugation is not a Möbius transformation, and conjugate Möbius transformations (obtained
by conjugating each matrix element) do not represent conjugation function (although they are
somewhat related).›
lift_definition conjugate_moebius_mmat :: "moebius_mat ⇒ moebius_mat" is mat_cnj
by auto
lift_definition conjugate_moebius :: "moebius ⇒ moebius" is conjugate_moebius_mmat
by transfer (auto simp add: mat_cnj_def)
lemma conjugate_moebius:
shows "conjugate ∘ moebius_pt M = moebius_pt (conjugate_moebius M) ∘ conjugate"
apply (rule ext, simp)
apply (transfer, transfer)
using vec_cnj_mult_mv by auto
subsection ‹Decomposition of M\"obius transformations›
text ‹Every Euclidean similarity can be decomposed using translations, rotations, and dilatations.›
lemma similarity_decomposition:
assumes "a ≠ 0"
shows "moebius_similarity a b = (moebius_translation b) + (moebius_rotation (arg a)) + (moebius_dilatation (cmod a))"
proof-
have "moebius_similarity a b = (moebius_translation b) + (moebius_rotation_dilatation a)"
using assms
unfolding moebius_rotation_dilatation_def moebius_translation_def moebius_similarity_def
by auto
thus ?thesis
using moebius_rotation_dilatation [OF assms]
by (auto simp add: add.assoc simp del: plus_moebius_def)
qed
text ‹A very important fact is that every Möbius transformation can be
composed of Euclidean similarities and a reciprocation.›
lemma moebius_decomposition:
assumes "c ≠ 0" and "a*d - b*c ≠ 0"
shows "mk_moebius a b c d =
moebius_translation (a/c) +
moebius_rotation_dilatation ((b*c - a*d)/(c*c)) +
moebius_reciprocal +
moebius_translation (d/c)"
using assms
unfolding moebius_rotation_dilatation_def moebius_translation_def moebius_similarity_def plus_moebius_def moebius_reciprocal_def
by (simp add: field_simps) (transfer, transfer, auto simp add: field_simps, rule_tac x="1/c" in exI, simp)
lemma moebius_decomposition_similarity:
assumes "a ≠ 0"
shows "mk_moebius a b 0 d = moebius_similarity (a/d) (b/d)"
using assms
unfolding moebius_similarity_def
by (transfer, transfer, auto, rule_tac x="1/d" in exI, simp)
text ‹Decomposition is used in many proofs. Namely, to show that every Möbius transformation has
some property, it suffices to show that reciprocation and all Euclidean similarities have that
property, and that the property is preserved under compositions.›
lemma wlog_moebius_decomposition:
assumes
trans: "⋀ v. P (moebius_translation v)" and
rot: "⋀ α. P (moebius_rotation α)" and
dil: "⋀ k. P (moebius_dilatation k)" and
recip: "P (moebius_reciprocal)" and
comp: "⋀ M1 M2. ⟦P M1; P M2⟧ ⟹ P (M1 + M2)"
shows "P M"
proof-
obtain a b c d where "M = mk_moebius a b c d" "mat_det (a, b, c, d) ≠ 0"
using ex_mk_moebius[of M]
by auto
show ?thesis
proof (cases "c = 0")
case False
show ?thesis
using moebius_decomposition[of c a d b] ‹mat_det (a, b, c, d) ≠ 0› ‹c ≠ 0› ‹M = mk_moebius a b c d›
using moebius_rotation_dilatation[of "(b*c - a*d) / (c*c)"]
using trans[of "a/c"] rot[of "arg ((b*c - a*d) / (c*c))"] dil[of "cmod ((b*c - a*d) / (c*c))"] recip
using comp
by (simp add: trans)
next
case True
hence "M = moebius_similarity (a/d) (b/d)"
using ‹M = mk_moebius a b c d› ‹mat_det (a, b, c, d) ≠ 0›
using moebius_decomposition_similarity
by auto
thus ?thesis
using ‹c = 0› ‹mat_det (a, b, c, d) ≠ 0›
using similarity_decomposition[of "a/d" "b/d"]
using trans[of "b/d"] rot[of "arg (a/d)"] dil[of "cmod (a/d)"] comp
by simp
qed
qed
subsection ‹Cross ratio and Möbius existence›
text ‹For any fixed three points $z1$, $z2$ and $z3$, @{term "cross_ratio z z1 z2 z3"} can be seen as
a function of a single variable $z$.›
lemma is_moebius_cross_ratio:
assumes "z1 ≠ z2" and "z2 ≠ z3" and "z1 ≠ z3"
shows "is_moebius (λ z. cross_ratio z z1 z2 z3)"
proof-
have "∃ M. ∀ z. cross_ratio z z1 z2 z3 = moebius_pt M z"
using assms
proof (transfer, transfer)
fix z1 z2 z3
assume vz: "z1 ≠ vec_zero" "z2 ≠ vec_zero" "z3 ≠ vec_zero"
obtain z1' z1'' where zz1: "z1 = (z1', z1'')"
by (cases z1, auto)
obtain z2' z2'' where zz2: "z2 = (z2', z2'')"
by (cases z2, auto)
obtain z3' z3'' where zz3: "z3 = (z3', z3'')"
by (cases z3, auto)
let ?m23 = "z2'*z3''-z3'*z2''"
let ?m21 = "z2'*z1''-z1'*z2''"
let ?m13 = "z1'*z3''-z3'*z1''"
let ?M = "(z1''*?m23, -z1'*?m23, z3''*?m21, -z3'*?m21)"
assume "¬ z1 ≈⇩v z2" "¬ z2 ≈⇩v z3" "¬ z1 ≈⇩v z3"
hence *: "?m23 ≠ 0" "?m21 ≠ 0" "?m13 ≠ 0"
using vz zz1 zz2 zz3
using complex_cvec_eq_mix[of z1' z1'' z2' z2'']
using complex_cvec_eq_mix[of z1' z1'' z3' z3'']
using complex_cvec_eq_mix[of z2' z2'' z3' z3'']
by (auto simp del: complex_cvec_eq_def simp add: field_simps)
have "mat_det ?M = ?m21*?m23*?m13"
by (simp add: field_simps)
hence "mat_det ?M ≠ 0"
using *
by simp
moreover
have "∀z∈{v. v ≠ vec_zero}. cross_ratio_cvec z z1 z2 z3 ≈⇩v moebius_pt_cmat_cvec ?M z"
proof
fix z
assume "z ∈ {v. v ≠ vec_zero}"
hence "z ≠ vec_zero"
by simp
obtain z' z'' where zz: "z = (z', z'')"
by (cases z, auto)
let ?m01 = "z'*z1''-z1'*z''"
let ?m03 = "z'*z3''-z3'*z''"
have "?m01 ≠ 0 ∨ ?m03 ≠ 0"
proof (cases "z'' = 0 ∨ z1'' = 0 ∨ z3'' = 0")
case True
thus ?thesis
using * ‹z ≠ vec_zero› zz
by auto
next
case False
hence 1: "z'' ≠ 0 ∧ z1'' ≠ 0 ∧ z3'' ≠ 0"
by simp
show ?thesis
proof (rule ccontr)
assume "¬ ?thesis"
hence "z' * z1'' - z1' * z'' = 0" "z' * z3'' - z3' * z'' = 0"
by auto
hence "z1'/z1'' = z3'/z3''"
using 1 zz ‹z ≠ vec_zero›
by (metis frac_eq_eq right_minus_eq)
thus False
using * 1
using frac_eq_eq
by auto
qed
qed
note * = * this
show "cross_ratio_cvec z z1 z2 z3 ≈⇩v moebius_pt_cmat_cvec ?M z"
using * zz zz1 zz2 zz3 mult_mv_nonzero[of "z" ?M] ‹mat_det ?M ≠ 0›
by simp (rule_tac x="1" in exI, simp add: field_simps)
qed
ultimately
show "∃M∈{M. mat_det M ≠ 0}.
∀z∈{v. v ≠ vec_zero}. cross_ratio_cvec z z1 z2 z3 ≈⇩v moebius_pt_cmat_cvec M z"
by blast
qed
thus ?thesis
by (auto simp add: is_moebius_def)
qed
text ‹Using properties of the cross-ratio, it is shown that there is a Möbius transformation
mapping any three different points to $0_{hc}$, $1_{hc}$ and $\infty_{hc}$, respectively.›
lemma ex_moebius_01inf:
assumes "z1 ≠ z2" and "z1 ≠ z3" and "z2 ≠ z3"
shows "∃ M. ((moebius_pt M z1 = 0⇩h) ∧ (moebius_pt M z2 = 1⇩h) ∧ (moebius_pt M z3 = ∞⇩h))"
using assms
using is_moebius_cross_ratio[OF ‹z1 ≠ z2› ‹z2 ≠ z3› ‹z1 ≠ z3›]
using cross_ratio_0[OF ‹z1 ≠ z2› ‹z1 ≠ z3›] cross_ratio_1[OF ‹z1 ≠ z2› ‹z2 ≠ z3›] cross_ratio_inf[OF ‹z1 ≠ z3› ‹z2 ≠ z3›]
by (metis is_moebius_def)
text ‹There is a Möbius transformation mapping any three different points to any three different
points.›
lemma ex_moebius:
assumes "z1 ≠ z2" and "z1 ≠ z3" and "z2 ≠ z3"
"w1 ≠ w2" and "w1 ≠ w3" and "w2 ≠ w3"
shows "∃ M. ((moebius_pt M z1 = w1) ∧ (moebius_pt M z2 = w2) ∧ (moebius_pt M z3 = w3))"
proof-
obtain M1 where *: "moebius_pt M1 z1 = 0⇩h ∧ moebius_pt M1 z2 = 1⇩h ∧ moebius_pt M1 z3 = ∞⇩h"
using ex_moebius_01inf[OF assms(1-3)]
by auto
obtain M2 where **: "moebius_pt M2 w1 = 0⇩h ∧ moebius_pt M2 w2 = 1⇩h ∧ moebius_pt M2 w3 = ∞⇩h"
using ex_moebius_01inf[OF assms(4-6)]
by auto
let ?M = "moebius_comp (moebius_inv M2) M1"
show ?thesis
using * **
by (rule_tac x="?M" in exI, auto simp add: moebius_pt_invert)
qed
lemma ex_moebius_1:
shows "∃ M. moebius_pt M z1 = w1"
proof-
obtain z2 z3 where "z1 ≠ z2" "z1 ≠ z3" "z2 ≠ z3"
using ex_3_different_points[of z1]
by auto
moreover
obtain w2 w3 where "w1 ≠ w2" "w1 ≠ w3" "w2 ≠ w3"
using ex_3_different_points[of w1]
by auto
ultimately
show ?thesis
using ex_moebius[of z1 z2 z3 w1 w2 w3]
by auto
qed
text ‹The next lemma turns out to have very important applications in further proof development, as
it enables so called ,,without-loss-of-generality (wlog)'' reasoning \cite{wlog}. Namely, if the
property is preserved under Möbius transformations, then instead of three arbitrary different
points one can consider only the case of points $0_{hc}$, $1_{hc}$, and $\infty_{hc}$.›
lemma wlog_moebius_01inf:
fixes M::moebius
assumes "P 0⇩h 1⇩h ∞⇩h" and "z1 ≠ z2" and "z2 ≠ z3" and "z1 ≠ z3"
"⋀ M a b c. P a b c ⟹ P (moebius_pt M a) (moebius_pt M b) (moebius_pt M c)"
shows "P z1 z2 z3"
proof-
from assms obtain M where *:
"moebius_pt M z1 = 0⇩h" "moebius_pt M z2 = 1⇩h" "moebius_pt M z3 = ∞⇩h"
using ex_moebius_01inf[of z1 z2 z3]
by auto
have **: "moebius_pt (moebius_inv M) 0⇩h = z1" "moebius_pt (moebius_inv M) 1⇩h = z2" "moebius_pt (moebius_inv M) ∞⇩h = z3"
by (subst *[symmetric], simp)+
thus ?thesis
using assms
by auto
qed
subsection ‹Fixed points and Möbius transformation uniqueness›
lemma three_fixed_points_01inf:
assumes "moebius_pt M 0⇩h = 0⇩h" and "moebius_pt M 1⇩h = 1⇩h" and "moebius_pt M ∞⇩h = ∞⇩h"
shows "M = id_moebius"
using assms
by (transfer, transfer, auto)
lemma three_fixed_points:
assumes "z1 ≠ z2" and "z1 ≠ z3" and "z2 ≠ z3"
assumes "moebius_pt M z1 = z1" and "moebius_pt M z2 = z2" and "moebius_pt M z3 = z3"
shows "M = id_moebius"
proof-
from assms obtain M' where *: "moebius_pt M' z1 = 0⇩h" "moebius_pt M' z2 = 1⇩h" "moebius_pt M' z3 = ∞⇩h"
using ex_moebius_01inf[of z1 z2 z3]
by auto
have **: "moebius_pt (moebius_inv M') 0⇩h = z1" "moebius_pt (moebius_inv M') 1⇩h = z2" "moebius_pt (moebius_inv M') ∞⇩h = z3"
by (subst *[symmetric], simp)+
have "M' + M + (-M') = 0"
unfolding zero_moebius_def
apply (rule three_fixed_points_01inf)
using * ** assms
by (simp add: moebius_comp[symmetric])+
thus ?thesis
by (metis eq_neg_iff_add_eq_0 minus_add_cancel zero_moebius_def)
qed
lemma unique_moebius_three_points:
assumes "z1 ≠ z2" and "z1 ≠ z3" and "z2 ≠ z3"
assumes "moebius_pt M1 z1 = w1" and "moebius_pt M1 z2 = w2" and "moebius_pt M1 z3 = w3"
"moebius_pt M2 z1 = w1" and "moebius_pt M2 z2 = w2" and "moebius_pt M2 z3 = w3"
shows "M1 = M2"
proof-
let ?M = "moebius_comp (moebius_inv M2) M1"
have "moebius_pt ?M z1 = z1"
using ‹moebius_pt M1 z1 = w1› ‹moebius_pt M2 z1 = w1›
by (auto simp add: moebius_pt_invert)
moreover
have "moebius_pt ?M z2 = z2"
using ‹moebius_pt M1 z2 = w2› ‹moebius_pt M2 z2 = w2›
by (auto simp add: moebius_pt_invert)
moreover
have "moebius_pt ?M z3 = z3"
using ‹moebius_pt M1 z3 = w3› ‹moebius_pt M2 z3 = w3›
by (auto simp add: moebius_pt_invert)
ultimately
have "?M = id_moebius"
using assms three_fixed_points
by auto
thus ?thesis
by (metis add_minus_cancel left_minus plus_moebius_def uminus_moebius_def zero_moebius_def)
qed
text ‹There is a unique Möbius transformation mapping three different points to other three
different points.›
lemma ex_unique_moebius_three_points:
assumes "z1 ≠ z2" and "z1 ≠ z3" and "z2 ≠ z3"
"w1 ≠ w2" and "w1 ≠ w3" and "w2 ≠ w3"
shows "∃! M. ((moebius_pt M z1 = w1) ∧ (moebius_pt M z2 = w2) ∧ (moebius_pt M z3 = w3))"
proof-
obtain M where *: "moebius_pt M z1 = w1 ∧ moebius_pt M z2 = w2 ∧ moebius_pt M z3 = w3"
using ex_moebius[OF assms]
by auto
show ?thesis
unfolding Ex1_def
proof (rule_tac x="M" in exI, rule)
show "∀y. moebius_pt y z1 = w1 ∧ moebius_pt y z2 = w2 ∧ moebius_pt y z3 = w3 ⟶ y = M"
using *
using unique_moebius_three_points[OF assms(1-3)]
by simp
qed (simp add: *)
qed
lemma ex_unique_moebius_three_points_fun:
assumes "z1 ≠ z2" and "z1 ≠ z3" and "z2 ≠ z3"
"w1 ≠ w2" and "w1 ≠ w3" and "w2 ≠ w3"
shows "∃! f. is_moebius f ∧ (f z1 = w1) ∧ (f z2 = w2) ∧ (f z3 = w3)"
proof-
obtain M where "moebius_pt M z1 = w1" "moebius_pt M z2 = w2" "moebius_pt M z3 = w3"
using ex_unique_moebius_three_points[OF assms]
by auto
thus ?thesis
using ex_unique_moebius_three_points[OF assms]
unfolding Ex1_def
by (rule_tac x="moebius_pt M" in exI) (auto simp add: is_moebius_def)
qed
text ‹Different Möbius transformations produce different actions.›
lemma unique_moebius_pt:
assumes "moebius_pt M1 = moebius_pt M2"
shows "M1 = M2"
using assms unique_moebius_three_points[of "0⇩h" "1⇩h" "∞⇩h"]
by auto
lemma is_cross_ratio_01inf:
assumes "z1 ≠ z2" and "z1 ≠ z3" and "z2 ≠ z3" and "is_moebius f"
assumes "f z1 = 0⇩h" and "f z2 = 1⇩h" and "f z3 = ∞⇩h"
shows "f = (λ z. cross_ratio z z1 z2 z3)"
using assms
using cross_ratio_0[OF ‹z1 ≠ z2› ‹z1 ≠ z3›] cross_ratio_1[OF ‹z1 ≠ z2› ‹z2 ≠ z3›] cross_ratio_inf[OF ‹z1 ≠ z3› ‹z2 ≠ z3›]
using is_moebius_cross_ratio[OF ‹z1 ≠ z2› ‹z2 ≠ z3› ‹z1 ≠ z3›]
using ex_unique_moebius_three_points_fun[OF ‹z1 ≠ z2› ‹z1 ≠ z3› ‹z2 ≠ z3›, of "0⇩h" "1⇩h" "∞⇩h"]
by auto
text ‹Möbius transformations preserve cross-ratio.›
lemma moebius_preserve_cross_ratio [simp]:
assumes "z1 ≠ z2" and "z1 ≠ z3" and "z2 ≠ z3"
shows "cross_ratio (moebius_pt M z) (moebius_pt M z1) (moebius_pt M z2) (moebius_pt M z3) =
cross_ratio z z1 z2 z3"
proof-
let ?f = "λ z. cross_ratio z z1 z2 z3"
let ?M = "moebius_pt M"
let ?iM = "inv ?M"
have "(?f ∘ ?iM) (?M z1) = 0⇩h"
using bij_moebius_pt[of M] cross_ratio_0[OF ‹z1 ≠ z2› ‹z1 ≠ z3›]
by (simp add: bij_def)
moreover
have "(?f ∘ ?iM) (?M z2) = 1⇩h"
using bij_moebius_pt[of M] cross_ratio_1[OF ‹z1 ≠ z2› ‹z2 ≠ z3›]
by (simp add: bij_def)
moreover
have "(?f ∘ ?iM) (?M z3) = ∞⇩h"
using bij_moebius_pt[of M] cross_ratio_inf[OF ‹z1 ≠ z3› ‹z2 ≠ z3›]
by (simp add: bij_def)
moreover
have "is_moebius (?f ∘ ?iM)"
by (rule is_moebius_comp, rule is_moebius_cross_ratio[OF ‹z1 ≠ z2› ‹z2 ≠ z3› ‹z1 ≠ z3›], rule is_moebius_inv, auto simp add: is_moebius_def)
moreover
have "?M z1 ≠ ?M z2" "?M z1 ≠ ?M z3" "?M z2 ≠ ?M z3"
using assms
by simp_all
ultimately
have "?f ∘ ?iM = (λ z. cross_ratio z (?M z1) (?M z2) (?M z3))"
using assms
using is_cross_ratio_01inf[of "?M z1" "?M z2" "?M z3" "?f ∘ ?iM"]
by simp
moreover
have "(?f ∘ ?iM) (?M z) = cross_ratio z z1 z2 z3"
using bij_moebius_pt[of M]
by (simp add: bij_def)
moreover
have "(λ z. cross_ratio z (?M z1) (?M z2) (?M z3)) (?M z) = cross_ratio (?M z) (?M z1) (?M z2) (?M z3)"
by simp
ultimately
show ?thesis
by simp
qed
lemma conjugate_cross_ratio [simp]:
assumes "z1 ≠ z2" and "z1 ≠ z3" and "z2 ≠ z3"
shows "cross_ratio (conjugate z) (conjugate z1) (conjugate z2) (conjugate z3) =
conjugate (cross_ratio z z1 z2 z3)"
proof-
let ?f = "λ z. cross_ratio z z1 z2 z3"
let ?M = "conjugate"
let ?iM = "conjugate"
have "(conjugate ∘ ?f ∘ ?iM) (?M z1) = 0⇩h"
using cross_ratio_0[OF ‹z1 ≠ z2› ‹z1 ≠ z3›]
by simp
moreover
have "(conjugate ∘ ?f ∘ ?iM) (?M z2) = 1⇩h"
using cross_ratio_1[OF ‹z1 ≠ z2› ‹z2 ≠ z3›]
by simp
moreover
have "(conjugate ∘ ?f ∘ ?iM) (?M z3) = ∞⇩h"
using cross_ratio_inf[OF ‹z1 ≠ z3› ‹z2 ≠ z3›]
by simp
moreover
have "is_moebius (conjugate ∘ ?f ∘ ?iM)"
proof-
obtain M where "?f = moebius_pt M"
using is_moebius_cross_ratio[OF ‹z1 ≠ z2› ‹z2 ≠ z3› ‹z1 ≠ z3›]
by (auto simp add: is_moebius_def)
thus ?thesis
using conjugate_moebius[of M]
by (auto simp add: comp_assoc is_moebius_def)
qed
moreover
have "?M z1 ≠ ?M z2" "?M z1 ≠ ?M z3" "?M z2 ≠ ?M z3"
using assms
by (auto simp add: conjugate_inj)
ultimately
have "conjugate ∘ ?f ∘ ?iM = (λ z. cross_ratio z (?M z1) (?M z2) (?M z3))"
using assms
using is_cross_ratio_01inf[of "?M z1" "?M z2" "?M z3" "conjugate ∘ ?f ∘ ?iM"]
by simp
moreover
have "(conjugate ∘ ?f ∘ ?iM) (?M z) = conjugate (cross_ratio z z1 z2 z3)"
by simp
moreover
have "(λ z. cross_ratio z (?M z1) (?M z2) (?M z3)) (?M z) = cross_ratio (?M z) (?M z1) (?M z2) (?M z3)"
by simp
ultimately
show ?thesis
by simp
qed
lemma cross_ratio_reciprocal [simp]:
assumes "u ≠ v" and "v ≠ w" and "u ≠ w"
shows "cross_ratio (reciprocal z) (reciprocal u) (reciprocal v) (reciprocal w) =
cross_ratio z u v w"
using assms
by (subst moebius_reciprocal[symmetric])+ (simp del: moebius_reciprocal)
lemma cross_ratio_inversion [simp]:
assumes "u ≠ v" and "v ≠ w" and "u ≠ w"
shows "cross_ratio (inversion z) (inversion u) (inversion v) (inversion w) =
conjugate (cross_ratio z u v w)"
proof-
have "reciprocal u ≠ reciprocal v" "reciprocal u ≠ reciprocal w" "reciprocal v ≠ reciprocal w"
using assms
by ((subst moebius_reciprocal[symmetric])+, simp del: moebius_reciprocal)+
thus ?thesis
using assms
unfolding inversion_def
by simp
qed
lemma fixed_points_0inf':
assumes "moebius_pt M 0⇩h = 0⇩h" and "moebius_pt M ∞⇩h = ∞⇩h"
shows "∃ k::complex_homo. (k ≠ 0⇩h ∧ k ≠ ∞⇩h) ∧ (∀ z. moebius_pt M z = k *⇩h z)"
using assms
proof (transfer, transfer)
fix M :: complex_mat
assume "mat_det M ≠ 0"
obtain a b c d where MM: "M = (a, b, c, d)"
by (cases M) auto
assume "moebius_pt_cmat_cvec M 0⇩v ≈⇩v 0⇩v" "moebius_pt_cmat_cvec M ∞⇩v ≈⇩v ∞⇩v"
hence *: "b = 0" "c = 0" "a ≠ 0 ∧ d ≠ 0"
using MM
by auto
let ?z = "(a, d)"
have "?z ≠ vec_zero"
using *
by simp
moreover
have "¬ ?z ≈⇩v 0⇩v ∧ ¬ ?z ≈⇩v ∞⇩v"
using *
by simp
moreover
have "∀z∈{v. v ≠ vec_zero}. moebius_pt_cmat_cvec M z ≈⇩v ?z *⇩v z"
using MM ‹mat_det M ≠ 0› *
by force
ultimately
show "∃k∈{v. v ≠ vec_zero}.
(¬ k ≈⇩v 0⇩v ∧ ¬ k ≈⇩v ∞⇩v) ∧
(∀z∈{v. v ≠ vec_zero}. moebius_pt_cmat_cvec M z ≈⇩v k *⇩v z)"
by blast
qed
lemma fixed_points_0inf:
assumes "moebius_pt M 0⇩h = 0⇩h" and "moebius_pt M ∞⇩h = ∞⇩h"
shows "∃ k::complex_homo. (k ≠ 0⇩h ∧ k ≠ ∞⇩h) ∧ moebius_pt M = (λ z. k *⇩h z)"
using fixed_points_0inf'[OF assms]
by auto
lemma ex_cross_ratio:
assumes "u ≠ v" and "u ≠ w" and "v ≠ w"
shows "∃ z. cross_ratio z u v w = c"
proof-
obtain M where "(λ z. cross_ratio z u v w) = moebius_pt M"
using assms is_moebius_cross_ratio[of u v w]
unfolding is_moebius_def
by auto
hence *: "∀ z. cross_ratio z u v w = moebius_pt M z"
by metis
let ?z = "moebius_pt (-M) c"
have "cross_ratio ?z u v w = c"
using *
by auto
thus ?thesis
by auto
qed
lemma unique_cross_ratio:
assumes "u ≠ v" and "v ≠ w" and "u ≠ w"
assumes "cross_ratio z u v w = cross_ratio z' u v w"
shows "z = z'"
proof-
obtain M where "(λ z. cross_ratio z u v w) = moebius_pt M"
using is_moebius_cross_ratio[OF assms(1-3)]
unfolding is_moebius_def
by auto
hence "moebius_pt M z = moebius_pt M z'"
using assms(4)
by metis
thus ?thesis
using moebius_pt_eq_I
by metis
qed
lemma ex1_cross_ratio:
assumes "u ≠ v" and "u ≠ w" and "v ≠ w"
shows "∃! z. cross_ratio z u v w = c"
using assms ex_cross_ratio[OF assms, of c] unique_cross_ratio[of u v w]
by blast
subsection ‹Pole›
definition is_pole :: "moebius ⇒ complex_homo ⇒ bool" where
"is_pole M z ⟷ moebius_pt M z = ∞⇩h"
lemma ex1_pole:
shows "∃! z. is_pole M z"
using bij_moebius_pt[of M]
unfolding is_pole_def bij_def inj_on_def surj_def
unfolding Ex1_def
by (metis UNIV_I)
definition pole :: "moebius ⇒ complex_homo" where
"pole M = (THE z. is_pole M z)"
lemma pole_mk_moebius:
assumes "is_pole (mk_moebius a b c d) z" and "c ≠ 0" and "a*d - b*c ≠ 0"
shows "z = of_complex (-d/c)"
proof-
let ?t1 = "moebius_translation (a / c)"
let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))"
let ?r = "moebius_reciprocal"
let ?t2 = "moebius_translation (d / c)"
have "moebius_pt (?rd + ?r + ?t2) z = ∞⇩h"
using assms
unfolding is_pole_def
apply (subst (asm) moebius_decomposition)
apply (auto simp add: moebius_comp[symmetric] moebius_translation_def)
apply (subst moebius_similarity_only_inf_to_inf[of 1 "a/c"], auto)
done
hence "moebius_pt (?r + ?t2) z = ∞⇩h"
using ‹a*d - b*c ≠ 0› ‹c ≠ 0›
unfolding moebius_rotation_dilatation_def
by (simp del: moebius_pt_moebius_similarity)
hence "moebius_pt ?t2 z = 0⇩h"
by simp
thus ?thesis
using moebius_pt_invert[of ?t2 z "0⇩h"]
by simp ((subst (asm) of_complex_zero[symmetric])+, simp del: of_complex_zero)
qed
lemma pole_similarity:
assumes "is_pole (moebius_similarity a b) z" and "a ≠ 0"
shows "z = ∞⇩h"
using assms
unfolding is_pole_def
using moebius_similarity_only_inf_to_inf[of a b z]
by simp
subsection ‹Homographies and antihomographies›
text ‹Inversion is not a Möbius transformation (it is a canonical example of so called
anti-Möbius transformations, or antihomographies). All antihomographies are compositions of
homographies and conjugation. The fundamental theorem of projective geometry (that we shall not
prove) states that all automorphisms (bijective functions that preserve the cross-ratio) of
$\mathbb{C}P^1$ are either homographies or antihomographies.›
definition is_homography :: "(complex_homo ⇒ complex_homo) ⇒ bool" where
"is_homography f ⟷ is_moebius f"
definition is_antihomography :: "(complex_homo ⇒ complex_homo) ⇒ bool" where
"is_antihomography f ⟷ (∃ f'. is_moebius f' ∧ f = f' ∘ conjugate)"
text ‹Conjugation is not a Möbius transformation, but is antihomograhpy.›
lemma not_moebius_conjugate:
shows "¬ is_moebius conjugate"
proof
assume "is_moebius conjugate"
then obtain M where *: "moebius_pt M = conjugate"
unfolding is_moebius_def
by metis
hence "moebius_pt M 0⇩h = 0⇩h" "moebius_pt M 1⇩h = 1⇩h" "moebius_pt M ∞⇩h = ∞⇩h"
by auto
hence "M = id_moebius"
using three_fixed_points_01inf
by auto
hence "conjugate = id"
using *
by simp
moreover
have "conjugate ii⇩h ≠ ii⇩h"
using of_complex_inj[of "𝗂" "-𝗂"]
by (subst of_complex_ii[symmetric])+ (auto simp del: of_complex_ii)
ultimately
show False
by simp
qed
lemma conjugation_is_antihomography[simp]:
shows "is_antihomography conjugate"
unfolding is_antihomography_def
by (rule_tac x="id" in exI, metis fun.map_id0 id_apply is_moebius_def moebius_pt_moebius_id)
lemma inversion_is_antihomography [simp]:
shows "is_antihomography inversion"
using moebius_reciprocal
unfolding inversion_sym is_antihomography_def is_moebius_def
by metis
text ‹Functions cannot simultaneously be homographies and antihomographies - the disjunction is exclusive.›
lemma homography_antihomography_exclusive:
assumes "is_antihomography f"
shows "¬ is_homography f"
proof
assume "is_homography f"
then obtain M where "f = moebius_pt M"
unfolding is_homography_def is_moebius_def
by auto
then obtain M' where "moebius_pt M = moebius_pt M' ∘ conjugate"
using assms
unfolding is_antihomography_def is_moebius_def
by auto
hence "conjugate = moebius_pt (-M') ∘ moebius_pt M"
by auto
hence "conjugate = moebius_pt (-M' + M)"
by (simp add: moebius_comp)
thus False
using not_moebius_conjugate
unfolding is_moebius_def
by metis
qed
subsection ‹Classification of Möbius transformations›
text ‹Möbius transformations can be classified to parabolic, elliptic and loxodromic. We do not
develop this part of the theory in depth.›
lemma similarity_scale_1:
assumes "k ≠ 0"
shows "similarity (k *⇩s⇩m I) M = similarity I M"
using assms
unfolding similarity_def
using mat_inv_mult_sm[of k I]
by simp
lemma similarity_scale_2:
shows "similarity I (k *⇩s⇩m M) = k *⇩s⇩m (similarity I M)"
unfolding similarity_def
by auto
lemma mat_trace_mult_sm [simp]:
shows "mat_trace (k *⇩s⇩m M) = k * mat_trace M"
by (cases M) (simp add: field_simps)
definition moebius_mb_cmat :: "complex_mat ⇒ complex_mat ⇒ complex_mat" where
[simp]: "moebius_mb_cmat I M = similarity I M"
lift_definition moebius_mb_mmat :: "moebius_mat ⇒ moebius_mat ⇒ moebius_mat" is moebius_mb_cmat
by (simp add: similarity_def mat_det_inv)
lift_definition moebius_mb :: "moebius ⇒ moebius ⇒ moebius" is moebius_mb_mmat
proof transfer
fix M M' I I'
assume "moebius_cmat_eq M M'" "moebius_cmat_eq I I'"
thus "moebius_cmat_eq (moebius_mb_cmat I M) (moebius_mb_cmat I' M')"
by (auto simp add: similarity_scale_1 similarity_scale_2)
qed
definition similarity_invar_cmat :: "complex_mat ⇒ complex" where
[simp]: "similarity_invar_cmat M = (mat_trace M)⇧2 / mat_det M - 4"
lift_definition similarity_invar_mmat :: "moebius_mat ⇒ complex" is similarity_invar_cmat
done
lift_definition similarity_invar :: "moebius ⇒ complex" is similarity_invar_mmat
by transfer (auto simp add: power2_eq_square field_simps)
lemma similarity_invar_moeibus_mb:
shows "similarity_invar (moebius_mb I M) = similarity_invar M"
by (transfer, transfer, simp)
definition similar :: "moebius ⇒ moebius ⇒ bool" where
"similar M1 M2 ⟷ (∃ I. moebius_mb I M1 = M2)"
lemma similar_refl [simp]:
shows "similar M M"
unfolding similar_def
by (rule_tac x="id_moebius" in exI) (transfer, transfer, simp)
lemma similar_sym:
assumes "similar M1 M2"
shows "similar M2 M1"
proof-
from assms obtain I where "M2 = moebius_mb I M1"
unfolding similar_def
by auto
hence "M1 = moebius_mb (moebius_inv I) M2"
proof (transfer, transfer)
fix M2 I M1
assume "moebius_cmat_eq M2 (moebius_mb_cmat I M1)" "mat_det I ≠ 0"
then obtain k where "k ≠ 0" "similarity I M1 = k *⇩s⇩m M2"
by auto
thus "moebius_cmat_eq M1 (moebius_mb_cmat (moebius_inv_cmat I) M2)"
using similarity_inv[of I M1 "k *⇩s⇩m M2", OF _ ‹mat_det I ≠ 0›]
by (auto simp add: similarity_scale_2) (rule_tac x="1/k" in exI, simp)
qed
thus ?thesis
unfolding similar_def
by auto
qed
lemma similar_trans:
assumes "similar M1 M2" and "similar M2 M3"
shows "similar M1 M3"
proof-
obtain I1 I2 where "moebius_mb I1 M1 = M2" "moebius_mb I2 M2 = M3"
using assms
by (auto simp add: similar_def)
thus ?thesis
unfolding similar_def
proof (rule_tac x="moebius_comp I1 I2" in exI, transfer, transfer)
fix I1 I2 M1 M2 M3
assume "moebius_cmat_eq (moebius_mb_cmat I1 M1) M2"
"moebius_cmat_eq (moebius_mb_cmat I2 M2) M3"
"mat_det I1 ≠ 0" "mat_det I2 ≠ 0"
thus "moebius_cmat_eq (moebius_mb_cmat (moebius_comp_cmat I1 I2) M1) M3"
by (auto simp add: similarity_scale_2) (rule_tac x="ka*k" in exI, simp)
qed
qed
end
Theory Circlines
section ‹Circlines›
theory Circlines
imports More_Set Moebius Hermitean_Matrices Elementary_Complex_Geometry
begin
subsection ‹Definition of circlines›
text ‹In our formalization we follow the approach described by Schwerdtfeger
\cite{schwerdtfeger} and represent circlines by Hermitean, non-zero
$2\times 2$ matrices. In the original formulation, a matrix
$\left(\begin{array}{cc}A & B\\C & D\end{array}\right)$ corresponds to
the equation $A\cdot z\cdot \overline{z} + B\cdot \overline{z} + C\cdot z + D = 0$,
where $C = \overline{B}$ and $A$ and $D$ are real (as the matrix is
Hermitean).›
abbreviation hermitean_nonzero where
"hermitean_nonzero ≡ {H. hermitean H ∧ H ≠ mat_zero}"
typedef circline_mat = hermitean_nonzero
by (rule_tac x="eye" in exI) (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
setup_lifting type_definition_circline_mat
definition circline_eq_cmat :: "complex_mat ⇒ complex_mat ⇒ bool" where
[simp]: "circline_eq_cmat A B ⟷ (∃ k::real. k ≠ 0 ∧ B = cor k *⇩s⇩m A)"
lemma symp_circline_eq_cmat: "symp circline_eq_cmat"
unfolding symp_def
proof ((rule allI)+, rule impI)
fix x y
assume "circline_eq_cmat x y"
then obtain k where "k ≠ 0 ∧ y = cor k *⇩s⇩m x"
by auto
hence "1 / k ≠ 0 ∧ x = cor (1 / k) *⇩s⇩m y"
by auto
thus "circline_eq_cmat y x"
unfolding circline_eq_cmat_def
by blast
qed
text‹Hermitean non-zero matrices are equivalent only to such matrices›
lemma circline_eq_cmat_hermitean_nonzero:
assumes "hermitean H ∧ H ≠ mat_zero" "circline_eq_cmat H H'"
shows "hermitean H' ∧ H' ≠ mat_zero"
using assms
by (metis circline_eq_cmat_def hermitean_mult_real nonzero_mult_real of_real_eq_0_iff)
lift_definition circline_eq_clmat :: "circline_mat ⇒ circline_mat ⇒ bool" is circline_eq_cmat
done
lemma circline_eq_clmat_refl [simp]: "circline_eq_clmat H H"
by transfer (simp, rule_tac x="1" in exI, simp)
quotient_type circline = circline_mat / circline_eq_clmat
proof (rule equivpI)
show "reflp circline_eq_clmat"
unfolding reflp_def
by transfer (auto, rule_tac x="1" in exI, simp)
next
show "symp circline_eq_clmat"
unfolding symp_def
by transfer (auto, (rule_tac x="1/k" in exI, simp)+)
next
show "transp circline_eq_clmat"
unfolding transp_def
by transfer (simp, safe, (rule_tac x="ka*k" in exI, simp)+)
qed
text ‹Circline with specified matrix›
text ‹An auxiliary constructor @{term mk_circline} returns a circline (an
equivalence class) for given four complex numbers $A$, $B$, $C$ and
$D$ (provided that they form a Hermitean, non-zero matrix).›
definition mk_circline_cmat :: "complex ⇒ complex ⇒ complex ⇒ complex ⇒ complex_mat" where
[simp]: "mk_circline_cmat A B C D =
(let M = (A, B, C, D)
in if M ∈ hermitean_nonzero then
M
else
eye)"
lift_definition mk_circline_clmat :: "complex ⇒ complex ⇒ complex ⇒ complex ⇒ circline_mat" is mk_circline_cmat
by (auto simp add: Let_def hermitean_def mat_adj_def mat_cnj_def)
lift_definition mk_circline :: "complex ⇒ complex ⇒ complex ⇒ complex ⇒ circline" is mk_circline_clmat
done
lemma ex_mk_circline:
shows "∃ A B C D. H = mk_circline A B C D ∧ hermitean (A, B, C, D) ∧ (A, B, C, D) ≠ mat_zero"
proof (transfer, transfer)
fix H
assume *: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where "H = (A, B, C, D)"
by (cases " H", auto)
hence "circline_eq_cmat H (mk_circline_cmat A B C D) ∧ hermitean (A, B, C, D) ∧ (A, B, C, D) ≠ mat_zero"
using *
by auto
thus "∃ A B C D. circline_eq_cmat H (mk_circline_cmat A B C D) ∧ hermitean (A, B, C, D) ∧ (A, B, C, D) ≠ mat_zero"
by blast
qed
subsection ‹Circline type›
definition circline_type_cmat :: "complex_mat ⇒ real" where
[simp]: "circline_type_cmat H = sgn (Re (mat_det H))"
lift_definition circline_type_clmat :: "circline_mat ⇒ real" is circline_type_cmat
done
lift_definition circline_type :: "circline ⇒ real" is circline_type_clmat
by transfer (simp, erule exE, simp add: sgn_mult)
lemma circline_type: "circline_type H = -1 ∨ circline_type H = 0 ∨ circline_type H = 1"
by (transfer, transfer, simp add: sgn_if)
lemma circline_type_mk_circline [simp]:
assumes "(A, B, C, D) ∈ hermitean_nonzero"
shows "circline_type (mk_circline A B C D) = sgn (Re (A*D - B*C))"
using assms
by (transfer, transfer, simp)
subsection ‹Points on the circline›
text ‹Each circline determines a corresponding set of points. Again, a description given in
homogeneous coordinates is a bit better than the original description defined only for ordinary
complex numbers. The point with homogeneous coordinates $(z_1, z_2)$ will belong to the set of
circline points iff $A \cdot z_1\cdot \overline{z_1} + B\cdot \overline{z_1} \cdot z_2 + C\cdot z_1 \cdot\overline{z_2} +
D\cdot z_2 \cdot \overline{z_2} = 0$. Note that this is a quadratic form determined by a vector of
homogeneous coordinates and the Hermitean matrix.›
definition on_circline_cmat_cvec :: "complex_mat ⇒ complex_vec ⇒ bool" where
[simp]: "on_circline_cmat_cvec H z ⟷ quad_form z H = 0"
lift_definition on_circline_clmat_hcoords :: "circline_mat ⇒ complex_homo_coords ⇒ bool" is on_circline_cmat_cvec
done
lift_definition on_circline :: "circline ⇒ complex_homo ⇒ bool" is on_circline_clmat_hcoords
by transfer (simp del: quad_form_def, (erule exE)+, simp del: quad_form_def add: quad_form_scale_m quad_form_scale_v)
definition circline_set :: "circline ⇒ complex_homo set" where
"circline_set H = {z. on_circline H z}"
lemma circline_set_I [simp]:
assumes "on_circline H z"
shows "z ∈ circline_set H"
using assms
unfolding circline_set_def
by auto
abbreviation circline_equation where
"circline_equation A B C D z1 z2 ≡ A*z1*cnj z1 + B*z2*cnj z1 + C*cnj z2*z1 + D*z2*cnj z2 = 0"
lemma on_circline_cmat_cvec_circline_equation:
"on_circline_cmat_cvec (A, B, C, D) (z1, z2) ⟷ circline_equation A B C D z1 z2"
by (simp add: vec_cnj_def field_simps)
lemma circline_equation:
assumes "H = mk_circline A B C D" and "(A, B, C, D) ∈ hermitean_nonzero"
shows "of_complex z ∈ circline_set H ⟷ circline_equation A B C D z 1"
using assms
unfolding circline_set_def
by simp (transfer, transfer, simp add: vec_cnj_def field_simps)
text ‹Circlines trough 0 and inf.›
text ‹The circline represents a line when $A=0$ or a circle, otherwise.›
definition circline_A0_cmat :: "complex_mat ⇒ bool" where
[simp]: "circline_A0_cmat H ⟷ (let (A, B, C, D) = H in A = 0)"
lift_definition circline_A0_clmat :: "circline_mat ⇒ bool" is circline_A0_cmat
done
lift_definition circline_A0 :: "circline ⇒ bool" is circline_A0_clmat
by transfer auto
abbreviation is_line where
"is_line H ≡ circline_A0 H"
abbreviation is_circle where
"is_circle H ≡ ¬ circline_A0 H"
definition circline_D0_cmat :: "complex_mat ⇒ bool" where
[simp]: "circline_D0_cmat H ⟷ (let (A, B, C, D) = H in D = 0)"
lift_definition circline_D0_clmat :: "circline_mat ⇒ bool" is circline_D0_cmat
done
lift_definition circline_D0 :: "circline ⇒ bool" is circline_D0_clmat
by transfer auto
lemma inf_on_circline: "on_circline H ∞⇩h ⟷ circline_A0 H"
by (transfer, transfer, auto simp add: vec_cnj_def)
lemma
inf_in_circline_set: "∞⇩h ∈ circline_set H ⟷ is_line H"
using inf_on_circline
unfolding circline_set_def
by simp
lemma zero_on_circline: "on_circline H 0⇩h ⟷ circline_D0 H"
by (transfer, transfer, auto simp add: vec_cnj_def)
lemma
zero_in_circline_set: "0⇩h ∈ circline_set H ⟷ circline_D0 H"
using zero_on_circline
unfolding circline_set_def
by simp
subsection ‹Connection with circles and lines in the classic complex plane›
text ‹Every Euclidean circle and Euclidean line can be represented by a
circline.›
lemma classic_circline:
assumes "H = mk_circline A B C D" and "hermitean (A, B, C, D) ∧ (A, B, C, D) ≠ mat_zero"
shows "circline_set H - {∞⇩h} = of_complex ` circline (Re A) B (Re D)"
using assms
unfolding circline_set_def
proof (safe)
fix z
assume "hermitean (A, B, C, D)" "(A, B, C, D) ≠ mat_zero" "z ∈ circline (Re A) B (Re D)"
thus "on_circline (mk_circline A B C D) (of_complex z)"
using hermitean_elems[of A B C D]
by (transfer, transfer) (auto simp add: circline_def vec_cnj_def field_simps)
next
fix z
assume "of_complex z = ∞⇩h"
thus False
by simp
next
fix z
assume "hermitean (A, B, C, D)" "(A, B, C, D) ≠ mat_zero" "on_circline (mk_circline A B C D) z" "z ∉ of_complex ` circline (Re A) B (Re D)"
moreover
have "z ≠ ∞⇩h ⟶ z ∈ of_complex ` circline (Re A) B (Re D)"
proof
assume "z ≠ ∞⇩h"
show "z ∈ of_complex ` circline (Re A) B (Re D)"
proof
show "z = of_complex (to_complex z)"
using ‹z ≠ ∞⇩h›
by simp
next
show "to_complex z ∈ circline (Re A) B (Re D)"
using ‹on_circline (mk_circline A B C D) z› ‹z ≠ ∞⇩h›
using ‹hermitean (A, B, C, D)› ‹(A, B, C, D) ≠ mat_zero›
proof (transfer, transfer)
fix A B C D and z :: complex_vec
obtain z1 z2 where zz: "z = (z1, z2)"
by (cases z, auto)
assume *: "z ≠ vec_zero" "¬ z ≈⇩v ∞⇩v"
"on_circline_cmat_cvec (mk_circline_cmat A B C D) z"
"hermitean (A, B, C, D)" "(A, B, C, D) ≠ mat_zero"
have "z2 ≠ 0"
using ‹z ≠ vec_zero› ‹¬ z ≈⇩v ∞⇩v›
using inf_cvec_z2_zero_iff zz
by blast
thus "to_complex_cvec z ∈ circline (Re A) B (Re D)"
using * zz
using hermitean_elems[of A B C D]
by (simp add: vec_cnj_def circline_def field_simps)
qed
qed
qed
ultimately
show "z = ∞⇩h"
by simp
qed
text ‹The matrix of the circline representing circle determined with center and radius.›
definition mk_circle_cmat :: "complex ⇒ real ⇒ complex_mat" where
[simp]: "mk_circle_cmat a r = (1, -a, -cnj a, a*cnj a - cor r*cor r)"
lift_definition mk_circle_clmat :: "complex ⇒ real ⇒ circline_mat" is mk_circle_cmat
by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition mk_circle :: "complex ⇒ real ⇒ circline" is mk_circle_clmat
done
lemma is_circle_mk_circle: "is_circle (mk_circle a r)"
by (transfer, transfer, simp)
lemma circline_set_mk_circle [simp]:
assumes "r ≥ 0"
shows "circline_set (mk_circle a r) = of_complex ` circle a r"
proof-
let ?A = "1" and ?B = "-a" and ?C = "-cnj a" and ?D = "a*cnj a - cor r*cor r"
have *: "(?A, ?B, ?C, ?D) ∈ {H. hermitean H ∧ H ≠ mat_zero}"
by (simp add: hermitean_def mat_adj_def mat_cnj_def)
have "mk_circle a r = mk_circline ?A ?B ?C ?D"
using *
by (transfer, transfer, simp)
hence "circline_set (mk_circle a r) - {∞⇩h} = of_complex ` circline ?A ?B (Re ?D)"
using classic_circline[of "mk_circle a r" ?A ?B ?C ?D] *
by simp
moreover
have "circline ?A ?B (Re ?D) = circle a r"
by (rule circline_circle[of ?A "Re ?D" "?B" "circline ?A ?B (Re ?D)" "a" "r*r" r], simp_all add: cmod_square ‹r ≥ 0›)
moreover
have "∞⇩h ∉ circline_set (mk_circle a r)"
using inf_in_circline_set[of "mk_circle a r"] is_circle_mk_circle[of a r]
by auto
ultimately
show ?thesis
unfolding circle_def
by simp
qed
text ‹The matrix of the circline representing line determined with two (not equal) complex points.›
definition mk_line_cmat :: "complex ⇒ complex ⇒ complex_mat" where
[simp]: "mk_line_cmat z1 z2 =
(if z1 ≠ z2 then
let B = 𝗂 * (z2 - z1) in (0, B, cnj B, -cnj_mix B z1)
else
eye)"
lift_definition mk_line_clmat :: "complex ⇒ complex ⇒ circline_mat" is mk_line_cmat
by (auto simp add: Let_def hermitean_def mat_adj_def mat_cnj_def split: if_split_asm)
lift_definition mk_line :: "complex ⇒ complex ⇒ circline" is mk_line_clmat
done
lemma circline_set_mk_line [simp]:
assumes "z1 ≠ z2"
shows "circline_set (mk_line z1 z2) - {∞⇩h} = of_complex ` line z1 z2"
proof-
let ?A = "0" and ?B = "𝗂*(z2 - z1)"
let ?C = "cnj ?B" and ?D = "-cnj_mix ?B z1"
have *: "(?A, ?B, ?C, ?D) ∈ {H. hermitean H ∧ H ≠ mat_zero}"
using assms
by (simp add: hermitean_def mat_adj_def mat_cnj_def)
have "mk_line z1 z2 = mk_circline ?A ?B ?C ?D"
using * assms
by (transfer, transfer, auto simp add: Let_def)
hence "circline_set (mk_line z1 z2) - {∞⇩h} = of_complex ` circline ?A ?B (Re ?D)"
using classic_circline[of "mk_line z1 z2" ?A ?B ?C ?D] *
by simp
moreover
have "circline ?A ?B (Re ?D) = line z1 z2"
using ‹z1 ≠ z2›
using circline_line'
by simp
ultimately
show ?thesis
by simp
qed
text ‹The set of points determined by a circline is always
either an Euclidean circle or an Euclidean line. ›
text ‹Euclidean circle is determined by its center and radius.›
type_synonym euclidean_circle = "complex × real"
definition euclidean_circle_cmat :: "complex_mat ⇒ euclidean_circle" where
[simp]: "euclidean_circle_cmat H = (let (A, B, C, D) = H in (-B/A, sqrt(Re ((B*C - A*D)/(A*A)))))"
lift_definition euclidean_circle_clmat :: "circline_mat ⇒ euclidean_circle" is euclidean_circle_cmat
done
lift_definition euclidean_circle :: "circline ⇒ euclidean_circle" is euclidean_circle_clmat
proof transfer
fix H1 H2
assume hh: "hermitean H1 ∧ H1 ≠ mat_zero" "hermitean H2 ∧ H2 ≠ mat_zero"
obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)"
by (cases "H1") auto
obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)"
by (cases "H2") auto
assume "circline_eq_cmat H1 H2"
then obtain k where "k ≠ 0" and *: "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1"
using HH1 HH2
by auto
have "(cor k * B1 * (cor k * C1) - cor k * A1 * (cor k * D1)) = (cor k)⇧2 * (B1*C1 - A1*D1)"
"(cor k * A1 * (cor k * A1)) = (cor k)⇧2 * (A1*A1)"
by (auto simp add: field_simps power2_eq_square)
hence "(cor k * B1 * (cor k * C1) - cor k * A1 * (cor k * D1)) /
(cor k * A1 * (cor k * A1)) = (B1*C1 - A1*D1) / (A1*A1)"
using ‹k ≠ 0›
by (simp add: power2_eq_square)
thus "euclidean_circle_cmat H1 = euclidean_circle_cmat H2"
using HH1 HH2 * hh
by auto
qed
lemma classic_circle:
assumes "is_circle H" and "(a, r) = euclidean_circle H" and "circline_type H ≤ 0"
shows "circline_set H = of_complex ` circle a r"
proof-
obtain A B C D where *: "H = mk_circline A B C D" "hermitean (A, B, C, D)" "(A, B, C, D) ≠ mat_zero"
using ex_mk_circline[of H]
by auto
have "is_real A" "is_real D" "C = cnj B"
using * hermitean_elems
by auto
have "Re (A*D - B*C) ≤ 0"
using ‹circline_type H ≤ 0› *
by simp
hence **: "Re A * Re D ≤ (cmod B)⇧2"
using ‹is_real A› ‹is_real D› ‹C = cnj B›
by (simp add: cmod_square)
have "A ≠ 0"
using ‹is_circle H› * ‹is_real A›
by simp (transfer, transfer, simp)
hence "Re A ≠ 0"
using ‹is_real A›
by (metis complex_surj zero_complex.code)
have ***: "∞⇩h ∉ circline_set H"
using * inf_in_circline_set[of H] ‹is_circle H›
by simp
let ?a = "-B/A"
let ?r2 = "((cmod B)⇧2 - Re A * Re D) / (Re A)⇧2"
let ?r = "sqrt ?r2"
have "?a = a ∧ ?r = r"
using ‹(a, r) = euclidean_circle H›
using * ‹is_real A› ‹is_real D› ‹C = cnj B› ‹A ≠ 0›
apply simp
apply transfer
apply transfer
apply simp
apply (subst Re_divide_real)
apply (simp_all add: cmod_square, simp add: power2_eq_square)
done
show ?thesis
using * ** *** ‹Re A ≠ 0› ‹is_real A› ‹C = cnj B› ‹?a = a ∧ ?r = r›
using classic_circline[of H A B C D] assms circline_circle[of "Re A" "Re D" B "circline (Re A) B (Re D)" ?a ?r2 ?r]
by (simp add: circle_def)
qed
text ‹Euclidean line is represented by two points.›
type_synonym euclidean_line = "complex × complex"
definition euclidean_line_cmat :: "complex_mat ⇒ euclidean_line" where
[simp]: "euclidean_line_cmat H =
(let (A, B, C, D) = H;
z1 = -(D*B)/(2*B*C);
z2 = z1 + 𝗂 * sgn (if arg B > 0 then -B else B)
in (z1, z2))"
lift_definition euclidean_line_clmat :: "circline_mat ⇒ euclidean_line" is euclidean_line_cmat
done
lift_definition euclidean_line :: "circline ⇒ complex × complex" is euclidean_line_clmat
proof transfer
fix H1 H2
assume hh: "hermitean H1 ∧ H1 ≠ mat_zero" "hermitean H2 ∧ H2 ≠ mat_zero"
obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)"
by (cases "H1") auto
obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)"
by (cases "H2") auto
assume "circline_eq_cmat H1 H2"
then obtain k where "k ≠ 0" and *: "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1"
using HH1 HH2
by auto
have 1: "B1 ≠ 0 ∧ 0 < arg B1 ⟶ ¬ 0 < arg (- B1)"
using canon_ang_plus_pi1[of "arg B1"] arg_bounded[of B1]
by (auto simp add: arg_uminus)
have 2: "B1 ≠ 0 ∧ ¬ 0 < arg B1 ⟶ 0 < arg (- B1)"
using canon_ang_plus_pi2[of "arg B1"] arg_bounded[of B1]
by (auto simp add: arg_uminus)
show "euclidean_line_cmat H1 = euclidean_line_cmat H2"
using HH1 HH2 * ‹k ≠ 0›
by (cases "k > 0") (auto simp add: Let_def, simp_all add: norm_mult sgn_eq 1 2)
qed
lemma classic_line:
assumes "is_line H" and "circline_type H < 0" and "(z1, z2) = euclidean_line H"
shows "circline_set H - {∞⇩h} = of_complex ` line z1 z2"
proof-
obtain A B C D where *: "H = mk_circline A B C D" "hermitean (A, B, C, D)" "(A, B, C, D) ≠ mat_zero"
using ex_mk_circline[of H]
by auto
have "is_real A" "is_real D" "C = cnj B"
using * hermitean_elems
by auto
have "Re A = 0"
using ‹is_line H› * ‹is_real A› ‹is_real D› ‹C = cnj B›
by simp (transfer, transfer, simp)
have "B ≠ 0"
using ‹Re A = 0› ‹is_real A› ‹is_real D› ‹C = cnj B› * ‹circline_type H < 0›
using circline_type_mk_circline[of A B C D]
by auto
let ?z1 = "- cor (Re D) * B / (2 * B * cnj B)"
let ?z2 = "?z1 + 𝗂 * sgn (if 0 < arg B then - B else B)"
have "z1 = ?z1 ∧ z2 = ?z2"
using ‹(z1, z2) = euclidean_line H› * ‹is_real A› ‹is_real D› ‹C = cnj B›
by simp (transfer, transfer, simp add: Let_def)
thus ?thesis
using *
using classic_circline[of H A B C D] circline_line[of "Re A" B "circline (Re A) B (Re D)" "Re D" ?z1 ?z2] ‹Re A = 0› ‹B ≠ 0›
by simp
qed
subsection ‹Some special circlines›
subsubsection ‹Unit circle›
definition unit_circle_cmat :: complex_mat where
[simp]: "unit_circle_cmat = (1, 0, 0, -1)"
lift_definition unit_circle_clmat :: circline_mat is unit_circle_cmat
by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition unit_circle :: circline is unit_circle_clmat
done
lemma on_circline_cmat_cvec_unit:
shows "on_circline_cmat_cvec unit_circle_cmat (z1, z2) ⟷
z1 * cnj z1 = z2 * cnj z2"
by (simp add: vec_cnj_def field_simps)
lemma
one_on_unit_circle [simp]: "on_circline unit_circle 1⇩h" and
ii_on_unit_circle [simp]: "on_circline unit_circle ii⇩h" and
not_zero_on_unit_circle [simp]: "¬ on_circline unit_circle 0⇩h"
by (transfer, transfer, simp add: vec_cnj_def)+
lemma
one_in_unit_circle_set [simp]: "1⇩h ∈ circline_set unit_circle" and
ii_in_unit_circle_set [simp]: "ii⇩h ∈ circline_set unit_circle" and
zero_in_unit_circle_set [simp]: "0⇩h ∉ circline_set unit_circle"
unfolding circline_set_def
by simp_all
lemma is_circle_unit_circle [simp]:
shows "is_circle unit_circle"
by (transfer, transfer, simp)
lemma not_inf_on_unit_circle' [simp]:
shows "¬ on_circline unit_circle ∞⇩h"
using is_circle_unit_circle inf_on_circline
by blast
lemma not_inf_on_unit_circle'' [simp]:
shows "∞⇩h ∉ circline_set unit_circle"
by (simp add: inf_in_circline_set)
lemma euclidean_circle_unit_circle [simp]:
shows "euclidean_circle unit_circle = (0, 1)"
by (transfer, transfer, simp)
lemma circline_type_unit_circle [simp]:
shows "circline_type unit_circle = -1"
by (transfer, transfer, simp)
lemma on_circline_unit_circle [simp]:
shows "on_circline unit_circle (of_complex z) ⟷ cmod z = 1"
by (transfer, transfer, simp add: vec_cnj_def mult.commute)
lemma circline_set_unit_circle [simp]:
shows "circline_set unit_circle = of_complex ` {z. cmod z = 1}"
proof-
show ?thesis
proof safe
fix x
assume "x ∈ circline_set unit_circle"
then obtain x' where "x = of_complex x'"
using inf_or_of_complex[of x]
by auto
thus "x ∈ of_complex ` {z. cmod z = 1}"
using ‹x ∈ circline_set unit_circle›
unfolding circline_set_def
by auto
next
fix x
assume "cmod x = 1"
thus "of_complex x ∈ circline_set unit_circle"
unfolding circline_set_def
by auto
qed
qed
lemma circline_set_unit_circle_I [simp]:
assumes "cmod z = 1"
shows "of_complex z ∈ circline_set unit_circle"
using assms
unfolding circline_set_unit_circle
by simp
lemma inversion_unit_circle [simp]:
assumes "on_circline unit_circle x"
shows "inversion x = x"
proof-
obtain x' where "x = of_complex x'" "x' ≠ 0"
using inf_or_of_complex[of x]
using assms
by force
moreover
hence "x' * cnj x' = 1"
using assms
using circline_set_unit_circle
unfolding circline_set_def
by auto
hence "1 / cnj x' = x'"
using ‹x' ≠ 0›
by (simp add: field_simps)
ultimately
show ?thesis
using assms
unfolding inversion_def
by simp
qed
lemma inversion_id_iff_on_unit_circle:
shows "inversion a = a ⟷ on_circline unit_circle a"
using inversion_id_iff[of a] inf_or_of_complex[of a]
by auto
lemma on_unit_circle_conjugate [simp]:
shows "on_circline unit_circle (conjugate z) ⟷ on_circline unit_circle z"
by (transfer, transfer, auto simp add: vec_cnj_def field_simps)
lemma conjugate_unit_circle_set [simp]:
shows "conjugate ` (circline_set unit_circle) = circline_set unit_circle"
unfolding circline_set_def
by (auto simp add: image_iff, rule_tac x="conjugate x" in exI, simp)
subsubsection ‹x-axis›
definition x_axis_cmat :: complex_mat where
[simp]: "x_axis_cmat = (0, 𝗂, -𝗂, 0)"
lift_definition x_axis_clmat :: circline_mat is x_axis_cmat
by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition x_axis :: circline is x_axis_clmat
done
lemma special_points_on_x_axis' [simp]:
shows "on_circline x_axis 0⇩h" and "on_circline x_axis 1⇩h" and "on_circline x_axis ∞⇩h"
by (transfer, transfer, simp add: vec_cnj_def)+
lemma special_points_on_x_axis'' [simp]:
shows "0⇩h ∈ circline_set x_axis" and "1⇩h ∈ circline_set x_axis" and "∞⇩h ∈ circline_set x_axis"
unfolding circline_set_def
by auto
lemma is_line_x_axis [simp]:
shows "is_line x_axis"
by (transfer, transfer, simp)
lemma circline_type_x_axis [simp]:
shows "circline_type x_axis = -1"
by (transfer, transfer, simp)
lemma on_circline_x_axis:
shows "on_circline x_axis z ⟷ (∃ c. is_real c ∧ z = of_complex c) ∨ z = ∞⇩h"
proof safe
fix z c
assume "is_real c"
thus "on_circline x_axis (of_complex c)"
proof (transfer, transfer)
fix c
assume "is_real c"
thus "on_circline_cmat_cvec x_axis_cmat (of_complex_cvec c)"
using eq_cnj_iff_real[of c]
by (simp add: vec_cnj_def)
qed
next
fix z
assume "on_circline x_axis z" "z ≠ ∞⇩h"
thus "∃c. is_real c ∧ z = of_complex c"
proof (transfer, transfer, safe)
fix a b
assume "(a, b) ≠ vec_zero"
"on_circline_cmat_cvec x_axis_cmat (a, b)"
"¬ (a, b) ≈⇩v ∞⇩v"
hence "b ≠ 0" "cnj a * b = cnj b * a" using inf_cvec_z2_zero_iff
by (auto simp add: vec_cnj_def)
thus "∃c. is_real c ∧ (a, b) ≈⇩v of_complex_cvec c"
apply (rule_tac x="a/b" in exI)
apply (auto simp add: is_real_div field_simps)
apply (rule_tac x="1/b" in exI, simp)
done
qed
next
show "on_circline x_axis ∞⇩h"
by auto
qed
lemma on_circline_x_axis_I [simp]:
assumes "is_real z"
shows "on_circline x_axis (of_complex z)"
using assms
unfolding on_circline_x_axis
by auto
lemma circline_set_x_axis:
shows "circline_set x_axis = of_complex ` {x. is_real x} ∪ {∞⇩h}"
using on_circline_x_axis
unfolding circline_set_def
by auto
lemma circline_set_x_axis_I:
assumes "is_real z"
shows "of_complex z ∈ circline_set x_axis"
using assms
unfolding circline_set_x_axis
by auto
lemma circline_equation_x_axis:
shows "of_complex z ∈ circline_set x_axis ⟷ z = cnj z"
unfolding circline_set_x_axis
proof auto
fix x
assume "of_complex z = of_complex x" "is_real x"
hence "z = x"
using of_complex_inj[of z x]
by simp
thus "z = cnj z"
using eq_cnj_iff_real[of z] ‹is_real x›
by auto
next
assume "z = cnj z"
thus "of_complex z ∈ of_complex ` {x. is_real x} "
using eq_cnj_iff_real[of z]
by auto
qed
text ‹Positive and negative part of x-axis›
definition positive_x_axis where
"positive_x_axis = {z. z ∈ circline_set x_axis ∧ z ≠ ∞⇩h ∧ Re (to_complex z) > 0}"
definition negative_x_axis where
"negative_x_axis = {z. z ∈ circline_set x_axis ∧ z ≠ ∞⇩h ∧ Re (to_complex z) < 0}"
lemma circline_set_positive_x_axis_I [simp]:
assumes "is_real z" and "Re z > 0"
shows "of_complex z ∈ positive_x_axis"
using assms
unfolding positive_x_axis_def
by simp
lemma circline_set_negative_x_axis_I [simp]:
assumes "is_real z" and "Re z < 0"
shows "of_complex z ∈ negative_x_axis"
using assms
unfolding negative_x_axis_def
by simp
subsubsection ‹y-axis›
definition y_axis_cmat :: complex_mat where
[simp]: "y_axis_cmat = (0, 1, 1, 0)"
lift_definition y_axis_clmat :: circline_mat is y_axis_cmat
by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition y_axis :: circline is y_axis_clmat
done
lemma special_points_on_y_axis' [simp]:
shows "on_circline y_axis 0⇩h" and "on_circline y_axis ii⇩h" and "on_circline y_axis ∞⇩h"
by (transfer, transfer, simp add: vec_cnj_def)+
lemma special_points_on_y_axis'' [simp]:
shows "0⇩h ∈ circline_set y_axis" and "ii⇩h ∈ circline_set y_axis" and "∞⇩h ∈ circline_set y_axis"
unfolding circline_set_def
by auto
lemma on_circline_y_axis:
shows "on_circline y_axis z ⟷ (∃ c. is_imag c ∧ z = of_complex c) ∨ z = ∞⇩h"
proof safe
fix z c
assume "is_imag c"
thus "on_circline y_axis (of_complex c)"
proof (transfer, transfer)
fix c
assume "is_imag c"
thus "on_circline_cmat_cvec y_axis_cmat (of_complex_cvec c)"
using eq_minus_cnj_iff_imag[of c]
by (simp add: vec_cnj_def)
qed
next
fix z
assume "on_circline y_axis z" "z ≠ ∞⇩h"
thus "∃c. is_imag c ∧ z = of_complex c"
proof (transfer, transfer, safe)
fix a b
assume "(a, b) ≠ vec_zero"
"on_circline_cmat_cvec y_axis_cmat (a, b)"
"¬ (a, b) ≈⇩v ∞⇩v"
hence "b ≠ 0" "cnj a * b + cnj b * a = 0"
using inf_cvec_z2_zero_iff
by (blast, smt add.left_neutral add_cancel_right_right mult.commute mult.left_neutral mult_not_zero on_circline_cmat_cvec_circline_equation y_axis_cmat_def)
thus "∃c. is_imag c ∧ (a, b) ≈⇩v of_complex_cvec c"
using eq_minus_cnj_iff_imag[of "a / b"]
apply (rule_tac x="a/b" in exI)
apply (auto simp add: field_simps)
apply (rule_tac x="1/b" in exI, simp)
using add_eq_0_iff apply blast
apply (rule_tac x="1/b" in exI, simp)
done
qed
next
show "on_circline y_axis ∞⇩h"
by simp
qed
lemma on_circline_y_axis_I [simp]:
assumes "is_imag z"
shows "on_circline y_axis (of_complex z)"
using assms
unfolding on_circline_y_axis
by auto
lemma circline_set_y_axis:
shows "circline_set y_axis = of_complex ` {x. is_imag x} ∪ {∞⇩h}"
using on_circline_y_axis
unfolding circline_set_def
by auto
lemma circline_set_y_axis_I:
assumes "is_imag z"
shows "of_complex z ∈ circline_set y_axis"
using assms
unfolding circline_set_y_axis
by auto
text ‹Positive and negative part of y-axis›
definition positive_y_axis where
"positive_y_axis = {z. z ∈ circline_set y_axis ∧ z ≠ ∞⇩h ∧ Im (to_complex z) > 0}"
definition negative_y_axis where
"negative_y_axis = {z. z ∈ circline_set y_axis ∧ z ≠ ∞⇩h ∧ Im (to_complex z) < 0}"
lemma circline_set_positive_y_axis_I [simp]:
assumes "is_imag z" and "Im z > 0"
shows "of_complex z ∈ positive_y_axis"
using assms
unfolding positive_y_axis_def
by simp
lemma circline_set_negative_y_axis_I [simp]:
assumes "is_imag z" and "Im z < 0"
shows "of_complex z ∈ negative_y_axis"
using assms
unfolding negative_y_axis_def
by simp
subsubsection ‹Point zero as a circline›
definition circline_point_0_cmat :: complex_mat where
[simp]: "circline_point_0_cmat = (1, 0, 0, 0)"
lift_definition circline_point_0_clmat :: circline_mat is circline_point_0_cmat
by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition circline_point_0 :: circline is circline_point_0_clmat
done
lemma circline_type_circline_point_0 [simp]:
shows "circline_type circline_point_0 = 0"
by (transfer, transfer, simp)
lemma zero_in_circline_point_0 [simp]:
shows "0⇩h ∈ circline_set circline_point_0"
unfolding circline_set_def
by auto (transfer, transfer, simp add: vec_cnj_def)+
subsubsection ‹Imaginary unit circle›
definition imag_unit_circle_cmat :: complex_mat where
[simp]: "imag_unit_circle_cmat = (1, 0, 0, 1)"
lift_definition imag_unit_circle_clmat :: circline_mat is imag_unit_circle_cmat
by (simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition imag_unit_circle :: circline is imag_unit_circle_clmat
done
lemma circline_type_imag_unit_circle [simp]:
shows "circline_type imag_unit_circle = 1"
by (transfer, transfer, simp)
subsection ‹Intersection of circlines›
definition circline_intersection :: "circline ⇒ circline ⇒ complex_homo set" where
"circline_intersection H1 H2 = {z. on_circline H1 z ∧ on_circline H2 z}"
lemma circline_equation_cancel_z2:
assumes "circline_equation A B C D z1 z2 " and "z2 ≠ 0"
shows "circline_equation A B C D (z1/z2) 1"
using assms
by (simp add: field_simps)
lemma circline_equation_quadratic_equation:
assumes "circline_equation A B (cnj B) D z 1" and
"Re z = x" and "Im z = y" and "Re B = bx" and "Im B = by"
shows "A*x⇧2 + A*y⇧2 + 2*bx*x + 2*by*y + D = 0"
using assms
proof-
have "z = x + 𝗂*y" "B = bx + 𝗂*by"
using assms complex_eq
by auto
thus ?thesis
using assms
by (simp add: field_simps power2_eq_square)
qed
lemma circline_intersection_symetry:
shows "circline_intersection H1 H2 = circline_intersection H2 H1"
unfolding circline_intersection_def
by auto
subsection ‹Möbius action on circlines›
definition moebius_circline_cmat_cmat :: "complex_mat ⇒ complex_mat ⇒ complex_mat" where
[simp]: "moebius_circline_cmat_cmat M H = congruence (mat_inv M) H"
lift_definition moebius_circline_mmat_clmat :: "moebius_mat ⇒ circline_mat ⇒ circline_mat" is moebius_circline_cmat_cmat
using mat_det_inv congruence_nonzero hermitean_congruence
by simp
lift_definition moebius_circline :: "moebius ⇒ circline ⇒ circline" is moebius_circline_mmat_clmat
proof transfer
fix M M' H H'
assume "moebius_cmat_eq M M'" "circline_eq_cmat H H'"
thus "circline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M' H')"
by (auto simp add: mat_inv_mult_sm) (rule_tac x="ka / Re (k * cnj k)" in exI, auto simp add: complex_mult_cnj_cmod power2_eq_square)
qed
lemma moebius_preserve_circline_type [simp]:
shows "circline_type (moebius_circline M H) = circline_type H"
proof (transfer, transfer)
fix M H :: complex_mat
assume "mat_det M ≠ 0" "hermitean H ∧ H ≠ mat_zero"
thus "circline_type_cmat (moebius_circline_cmat_cmat M H) = circline_type_cmat H"
using Re_det_sgn_congruence[of "mat_inv M" "H"] mat_det_inv[of "M"]
by (simp del: congruence_def)
qed
text ‹The central lemma in this section connects the action of Möbius transformations on points and
on circlines.›
lemma moebius_circline:
shows "{z. on_circline (moebius_circline M H) z} =
moebius_pt M ` {z. on_circline H z}"
proof safe
fix z
assume "on_circline H z"
thus "on_circline (moebius_circline M H) (moebius_pt M z)"
proof (transfer, transfer)
fix z :: complex_vec and M H :: complex_mat
assume hh: "hermitean H ∧ H ≠ mat_zero" "z ≠ vec_zero" "mat_det M ≠ 0"
let ?z = "M *⇩m⇩v z"
let ?H = "mat_adj (mat_inv M) *⇩m⇩m H *⇩m⇩m (mat_inv M)"
assume *: "on_circline_cmat_cvec H z"
hence "quad_form z H = 0"
by simp
hence "quad_form ?z ?H = 0"
using quad_form_congruence[of M z H] hh
by simp
thus "on_circline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)"
by simp
qed
next
fix z
assume "on_circline (moebius_circline M H) z"
hence "∃ z'. z = moebius_pt M z' ∧ on_circline H z'"
proof (transfer, transfer)
fix z :: complex_vec and M H :: complex_mat
assume hh: "hermitean H ∧ H ≠ mat_zero" "z ≠ vec_zero" "mat_det M ≠ 0"
let ?iM = "mat_inv M"
let ?z' = "?iM *⇩m⇩v z"
assume *: "on_circline_cmat_cvec (moebius_circline_cmat_cmat M H) z"
have "?z' ≠ vec_zero"
using hh
using mat_det_inv mult_mv_nonzero
by auto
moreover
have "z ≈⇩v moebius_pt_cmat_cvec M ?z'"
using hh eye_mv_l mat_inv_r
by simp
moreover
have "M *⇩m⇩v (?iM *⇩m⇩v z) = z"
using hh eye_mv_l mat_inv_r
by auto
hence "on_circline_cmat_cvec H ?z'"
using hh *
using quad_form_congruence[of M "?iM *⇩m⇩v z" H, symmetric]
unfolding moebius_circline_cmat_cmat_def
unfolding on_circline_cmat_cvec_def
by simp
ultimately
show "∃z'∈{v. v ≠ vec_zero}. z ≈⇩v moebius_pt_cmat_cvec M z' ∧ on_circline_cmat_cvec H z'"
by blast
qed
thus "z ∈ moebius_pt M ` {z. on_circline H z}"
by auto
qed
lemma on_circline_moebius_circline_I [simp]:
assumes "on_circline H z"
shows "on_circline (moebius_circline M H) (moebius_pt M z)"
using assms moebius_circline
by fastforce
lemma circline_set_moebius_circline [simp]:
shows "circline_set (moebius_circline M H) = moebius_pt M ` circline_set H"
using moebius_circline[of M H]
unfolding circline_set_def
by auto
lemma circline_set_moebius_circline_I [simp]:
assumes "z ∈ circline_set H"
shows "moebius_pt M z ∈ circline_set (moebius_circline M H)"
using assms
by simp
lemma circline_set_moebius_circline_E:
assumes "moebius_pt M z ∈ circline_set (moebius_circline M H)"
shows "z ∈ circline_set H"
using assms
using moebius_pt_eq_I[of M z]
by auto
lemma circline_set_moebius_circline_iff [simp]:
shows "moebius_pt M z ∈ circline_set (moebius_circline M H) ⟷
z ∈ circline_set H"
using moebius_pt_eq_I[of M z]
by auto
lemma inj_moebius_circline:
shows "inj (moebius_circline M)"
unfolding inj_on_def
proof (safe)
fix H H'
assume "moebius_circline M H = moebius_circline M H'"
thus "H = H'"
proof (transfer, transfer)
fix M H H' :: complex_mat
assume hh: "mat_det M ≠ 0"
let ?iM = "mat_inv M"
assume "circline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M H')"
then obtain k where "congruence ?iM H' = congruence ?iM (cor k *⇩s⇩m H)" "k ≠ 0"
by auto
thus "circline_eq_cmat H H'"
using hh inj_congruence[of ?iM H' "cor k *⇩s⇩m H"] mat_det_inv[of M]
by auto
qed
qed
lemma moebius_circline_eq_I:
assumes "moebius_circline M H1 = moebius_circline M H2"
shows "H1 = H2"
using assms inj_moebius_circline[of M]
unfolding inj_on_def
by blast
lemma moebius_circline_neq_I [simp]:
assumes "H1 ≠ H2"
shows "moebius_circline M H1 ≠ moebius_circline M H2"
using assms inj_moebius_circline[of M]
unfolding inj_on_def
by blast
subsubsection ‹Group properties of Möbius action on ciclines›
text ‹Möbius actions on circlines have similar properties as Möbius actions on points.›
lemma moebius_circline_id [simp]:
shows "moebius_circline id_moebius H = H"
by (transfer, transfer) (simp add: mat_adj_def mat_cnj_def, rule_tac x=1 in exI, auto)
lemma moebius_circline_comp [simp]:
shows "moebius_circline (moebius_comp M1 M2) H = moebius_circline M1 (moebius_circline M2 H)"
by (transfer, transfer) (simp add: mat_inv_mult_mm, rule_tac x=1 in exI, simp add: mult_mm_assoc)
lemma moebius_circline_comp_inv_left [simp]:
shows "moebius_circline (moebius_inv M) (moebius_circline M H) = H"
by (subst moebius_circline_comp[symmetric], simp)
lemma moebius_circline_comp_inv_right [simp]:
shows "moebius_circline M (moebius_circline (moebius_inv M) H) = H"
by (subst moebius_circline_comp[symmetric], simp)
subsection ‹Action of Euclidean similarities on circlines›
lemma moebius_similarity_lines_to_lines [simp]:
assumes "a ≠ 0"
shows "∞⇩h ∈ circline_set (moebius_circline (moebius_similarity a b) H) ⟷
∞⇩h ∈ circline_set H"
using assms
by (metis circline_set_moebius_circline_iff moebius_similarity_inf)
lemma moebius_similarity_lines_to_lines':
assumes "a ≠ 0"
shows "on_circline (moebius_circline (moebius_similarity a b) H) ∞⇩h ⟷
∞⇩h ∈ circline_set H"
using moebius_similarity_lines_to_lines assms
unfolding circline_set_def
by simp
subsection ‹Conjugation, recpiprocation and inversion of circlines›
text ‹Conjugation of circlines›
definition conjugate_circline_cmat :: "complex_mat ⇒ complex_mat" where
[simp]: "conjugate_circline_cmat = mat_cnj"
lift_definition conjugate_circline_clmat :: "circline_mat ⇒ circline_mat" is conjugate_circline_cmat
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition conjugate_circline :: "circline ⇒ circline" is conjugate_circline_clmat
by transfer (metis circline_eq_cmat_def conjugate_circline_cmat_def hermitean_transpose mat_t_mult_sm)
lemma conjugate_circline_set':
shows "conjugate ` circline_set H ⊆ circline_set (conjugate_circline H)"
proof (safe)
fix z
assume "z ∈ circline_set H"
thus "conjugate z ∈ circline_set (conjugate_circline H)"
unfolding circline_set_def
apply simp
apply (transfer, transfer)
unfolding on_circline_cmat_cvec_def conjugate_cvec_def conjugate_circline_cmat_def
apply (subst quad_form_vec_cnj_mat_cnj, simp_all)
done
qed
lemma conjugate_conjugate_circline [simp]:
shows "conjugate_circline (conjugate_circline H) = H"
by (transfer, transfer, force)
lemma circline_set_conjugate_circline [simp]:
shows "circline_set (conjugate_circline H) = conjugate ` circline_set H" (is "?lhs = ?rhs")
proof (safe)
fix z
assume "z ∈ ?lhs"
show "z ∈ ?rhs"
proof
show "z = conjugate (conjugate z)"
by simp
next
show "conjugate z ∈ circline_set H"
using ‹z ∈ circline_set (conjugate_circline H)›
using conjugate_circline_set'[of "conjugate_circline H"]
by auto
qed
next
fix z
assume "z ∈ circline_set H"
thus "conjugate z ∈ circline_set (conjugate_circline H)"
using conjugate_circline_set'[of H]
by auto
qed
lemma on_circline_conjugate_circline [simp]:
shows "on_circline (conjugate_circline H) z ⟷ on_circline H (conjugate z)"
using circline_set_conjugate_circline[of H]
unfolding circline_set_def
by force
text ‹Inversion of circlines›
definition circline_inversion_cmat :: "complex_mat ⇒ complex_mat" where
[simp]: "circline_inversion_cmat H = (let (A, B, C, D) = H in (D, B, C, A))"
lift_definition circline_inversion_clmat :: "circline_mat ⇒ circline_mat" is circline_inversion_cmat
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition circline_inversion :: "circline ⇒ circline" is circline_inversion_clmat
by transfer auto
lemma on_circline_circline_inversion [simp]:
shows "on_circline (circline_inversion H) z ⟷ on_circline H (reciprocal (conjugate z))"
by (transfer, transfer, auto simp add: vec_cnj_def field_simps)
lemma circline_set_circline_inversion [simp]:
shows "circline_set (circline_inversion H) = inversion ` circline_set H"
unfolding circline_set_def inversion_def
by (force simp add: comp_def image_iff)
text ‹Reciprocal of circlines›
definition circline_reciprocal :: "circline ⇒ circline" where
"circline_reciprocal = conjugate_circline ∘ circline_inversion"
lemma circline_set_circline_reciprocal:
shows "circline_set (circline_reciprocal H) = reciprocal ` circline_set H"
unfolding circline_reciprocal_def comp_def
by (auto simp add: inversion_def image_iff)
text ‹Rotation of circlines›
lemma rotation_pi_2_y_axis [simp]:
shows "moebius_circline (moebius_rotation (pi/2)) y_axis = x_axis"
unfolding moebius_rotation_def moebius_similarity_def
by (transfer, transfer, simp add: mat_adj_def mat_cnj_def)
lemma rotation_minus_pi_2_y_axis [simp]:
shows "moebius_circline (moebius_rotation (-pi/2)) y_axis = x_axis"
unfolding moebius_rotation_def moebius_similarity_def
by (transfer, transfer, simp add: mat_adj_def mat_cnj_def, rule_tac x="-1" in exI, simp)
lemma rotation_minus_pi_2_x_axis [simp]:
shows "moebius_circline (moebius_rotation (-pi/2)) x_axis = y_axis"
unfolding moebius_rotation_def moebius_similarity_def
by (transfer, transfer, simp add: mat_adj_def mat_cnj_def)
lemma rotation_pi_2_x_axis [simp]:
shows "moebius_circline (moebius_rotation (pi/2)) x_axis = y_axis"
unfolding moebius_rotation_def moebius_similarity_def
by (transfer, transfer, simp add: mat_adj_def mat_cnj_def, rule_tac x="-1" in exI, simp)
lemma rotation_minus_pi_2_positive_y_axis [simp]:
shows "(moebius_pt (moebius_rotation (-pi/2))) ` positive_y_axis = positive_x_axis"
proof safe
fix y
assume y: "y ∈ positive_y_axis"
have *: "Re (a * 𝗂 / b) < 0 ⟷ Im (a / b) > 0" for a b
by (subst times_divide_eq_left [symmetric], subst mult.commute, subst Re_i_times) auto
from y * show "moebius_pt (moebius_rotation (-pi/2)) y ∈ positive_x_axis"
unfolding positive_y_axis_def positive_x_axis_def circline_set_def
unfolding moebius_rotation_def moebius_similarity_def
apply simp
apply transfer
apply transfer
apply (auto simp add: vec_cnj_def field_simps add_eq_0_iff)
done
next
fix x
assume x: "x ∈ positive_x_axis"
let ?y = "moebius_pt (moebius_rotation (pi/2)) x"
have *: "Im (a * 𝗂 / b) > 0 ⟷ Re (a / b) > 0" for a b
by (subst times_divide_eq_left [symmetric], subst mult.commute, subst Im_i_times) auto
hence "?y ∈ positive_y_axis"
using ‹x ∈ positive_x_axis›
unfolding positive_x_axis_def positive_y_axis_def
unfolding moebius_rotation_def moebius_similarity_def
unfolding circline_set_def
apply simp
apply transfer
apply transfer
apply (auto simp add: vec_cnj_def field_simps add_eq_0_iff)
done
thus "x ∈ moebius_pt (moebius_rotation (-pi/2)) ` positive_y_axis"
by (auto simp add: image_iff) (rule_tac x="?y" in bexI, simp_all)
qed
subsection ‹Circline uniqueness›
subsubsection ‹Zero type circline uniqueness›
lemma unique_circline_type_zero_0':
shows "(circline_type circline_point_0 = 0 ∧ 0⇩h ∈ circline_set circline_point_0) ∧
(∀ H. circline_type H = 0 ∧ 0⇩h ∈ circline_set H ⟶ H = circline_point_0)"
unfolding circline_set_def
proof (safe)
show "circline_type circline_point_0 = 0"
by (transfer, transfer, simp)
next
show "on_circline circline_point_0 0⇩h"
using circline_set_def zero_in_circline_point_0
by auto
next
fix H
assume "circline_type H = 0" "on_circline H 0⇩h"
thus "H = circline_point_0"
proof (transfer, transfer)
fix H :: complex_mat
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases "H") auto
hence *: "C = cnj B" "is_real A"
using hh hermitean_elems[of A B C D]
by auto
assume "circline_type_cmat H = 0" "on_circline_cmat_cvec H 0⇩v"
thus "circline_eq_cmat H circline_point_0_cmat"
using HH hh *
by (simp add: Let_def vec_cnj_def sgn_minus sgn_mult sgn_zero_iff)
(rule_tac x="1/Re A" in exI, cases A, cases B, simp add: Complex_eq sgn_zero_iff)
qed
qed
lemma unique_circline_type_zero_0:
shows "∃! H. circline_type H = 0 ∧ 0⇩h ∈ circline_set H"
using unique_circline_type_zero_0'
by blast
lemma unique_circline_type_zero:
shows "∃! H. circline_type H = 0 ∧ z ∈ circline_set H"
proof-
obtain M where ++: "moebius_pt M z = 0⇩h"
using ex_moebius_1[of z]
by auto
have +++: "z = moebius_pt (moebius_inv M) 0⇩h"
by (subst ++[symmetric]) simp
then obtain H0 where *: "circline_type H0 = 0 ∧ 0⇩h ∈ circline_set H0" and
**: "∀ H'. circline_type H' = 0 ∧ 0⇩h ∈ circline_set H' ⟶ H' = H0"
using unique_circline_type_zero_0
by auto
let ?H' = "moebius_circline (moebius_inv M) H0"
show ?thesis
unfolding Ex1_def
using * +++
proof (rule_tac x="?H'" in exI, simp, safe)
fix H'
assume "circline_type H' = 0" "moebius_pt (moebius_inv M) 0⇩h ∈ circline_set H'"
hence "0⇩h ∈ circline_set (moebius_circline M H')"
using ++ +++
by force
hence "moebius_circline M H' = H0"
using **[rule_format, of "moebius_circline M H'"]
using ‹circline_type H' = 0›
by simp
thus "H' = moebius_circline (moebius_inv M) H0"
by auto
qed
qed
subsubsection ‹Negative type circline uniqueness›
lemma unique_circline_01inf':
shows "0⇩h ∈ circline_set x_axis ∧ 1⇩h ∈ circline_set x_axis ∧ ∞⇩h ∈ circline_set x_axis ∧
(∀ H. 0⇩h ∈ circline_set H ∧ 1⇩h ∈ circline_set H ∧ ∞⇩h ∈ circline_set H ⟶ H = x_axis)"
proof safe
fix H
assume "0⇩h ∈ circline_set H" "1⇩h ∈ circline_set H" "∞⇩h ∈ circline_set H"
thus "H = x_axis"
unfolding circline_set_def
apply simp
proof (transfer, transfer)
fix H
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
have *: "C = cnj B" "A = 0 ∧ D = 0 ⟶ B ≠ 0"
using hermitean_elems[of A B C D] hh HH
by auto
obtain Bx By where "B = Complex Bx By"
by (cases B) auto
assume "on_circline_cmat_cvec H 0⇩v" "on_circline_cmat_cvec H 1⇩v" "on_circline_cmat_cvec H ∞⇩v"
thus "circline_eq_cmat H x_axis_cmat"
using * HH ‹C = cnj B› ‹B = Complex Bx By›
by (simp add: Let_def vec_cnj_def Complex_eq) (rule_tac x="1/By" in exI, auto)
qed
qed simp_all
lemma unique_circline_set:
assumes "A ≠ B" and "A ≠ C" and "B ≠ C"
shows "∃! H. A ∈ circline_set H ∧ B ∈ circline_set H ∧ C ∈ circline_set H"
proof-
let ?P = "λ A B C. A ≠ B ∧ A ≠ C ∧ B ≠ C ⟶ (∃! H. A ∈ circline_set H ∧ B ∈ circline_set H ∧ C ∈ circline_set H)"
have "?P A B C"
proof (rule wlog_moebius_01inf[of ?P])
fix M a b c
let ?M = "moebius_pt M"
assume "?P a b c"
show "?P (?M a) (?M b) (?M c)"
proof
assume "?M a ≠ ?M b ∧ ?M a ≠ ?M c ∧ ?M b ≠ ?M c"
hence "a ≠ b" "b ≠ c" "a ≠ c"
by auto
hence "∃!H. a ∈ circline_set H ∧ b ∈ circline_set H ∧ c ∈ circline_set H"
using ‹?P a b c›
by simp
then obtain H where
*: "a ∈ circline_set H ∧ b ∈ circline_set H ∧ c ∈ circline_set H" and
**: "∀H'. a ∈ circline_set H' ∧ b ∈ circline_set H' ∧ c ∈ circline_set H' ⟶ H' = H"
unfolding Ex1_def
by auto
let ?H' = "moebius_circline M H"
show "∃! H. ?M a ∈ circline_set H ∧ moebius_pt M b ∈ circline_set H ∧ moebius_pt M c ∈ circline_set H"
unfolding Ex1_def
proof (rule_tac x="?H'" in exI, rule)
show "?M a ∈ circline_set ?H' ∧ ?M b ∈ circline_set ?H' ∧ ?M c ∈ circline_set ?H'"
using *
by auto
next
show "∀H'. ?M a ∈ circline_set H' ∧ ?M b ∈ circline_set H' ∧ ?M c ∈ circline_set H' ⟶ H' = ?H'"
proof (safe)
fix H'
let ?iH' = "moebius_circline (moebius_inv M) H'"
assume "?M a ∈ circline_set H'" "?M b ∈ circline_set H'" "?M c ∈ circline_set H'"
hence "a ∈ circline_set ?iH' ∧ b ∈ circline_set ?iH' ∧ c ∈ circline_set ?iH'"
by simp
hence "H = ?iH'"
using **
by blast
thus "H' = moebius_circline M H"
by simp
qed
qed
qed
next
show "?P 0⇩h 1⇩h ∞⇩h"
using unique_circline_01inf'
unfolding Ex1_def
by (safe, rule_tac x="x_axis" in exI) auto
qed fact+
thus ?thesis
using assms
by simp
qed
lemma zero_one_inf_x_axis [simp]:
assumes "0⇩h ∈ circline_set H" and "1⇩h ∈ circline_set H" and "∞⇩h ∈ circline_set H"
shows "H = x_axis"
using assms unique_circline_set[of "0⇩h" "1⇩h" "∞⇩h"]
by auto
subsection ‹Circline set cardinality›
subsubsection ‹Diagonal circlines›
definition is_diag_circline_cmat :: "complex_mat ⇒ bool" where
[simp]: "is_diag_circline_cmat H = (let (A, B, C, D) = H in B = 0 ∧ C = 0)"
lift_definition is_diag_circline_clmat :: "circline_mat ⇒ bool" is is_diag_circline_cmat
done
lift_definition circline_diag :: "circline ⇒ bool" is is_diag_circline_clmat
by transfer auto
lemma circline_diagonalize:
shows "∃ M H'. moebius_circline M H = H' ∧ circline_diag H'"
proof (transfer, transfer)
fix H
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases "H") auto
hence HH_elems: "is_real A" "is_real D" "C = cnj B"
using hermitean_elems[of A B C D] hh
by auto
obtain M k1 k2 where *: "mat_det M ≠ 0" "unitary M" "congruence M H = (k1, 0, 0, k2)" "is_real k1" "is_real k2"
using hermitean_diagonizable[of H] hh
by auto
have "k1 ≠ 0 ∨ k2 ≠ 0"
using ‹congruence M H = (k1, 0, 0, k2)› hh congruence_nonzero[of H M] ‹mat_det M ≠ 0›
by auto
let ?M' = "mat_inv M"
let ?H' = "(k1, 0, 0, k2)"
have "circline_eq_cmat (moebius_circline_cmat_cmat ?M' H) ?H' ∧ is_diag_circline_cmat ?H'"
using *
by force
moreover
have "?H' ∈ hermitean_nonzero"
using * ‹k1 ≠ 0 ∨ k2 ≠ 0› eq_cnj_iff_real[of k1] eq_cnj_iff_real[of k2]
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
moreover
have "mat_det ?M' ≠ 0"
using * mat_det_inv[of M]
by auto
ultimately
show "∃M∈{M. mat_det M ≠ 0}.
∃H'∈hermitean_nonzero.
circline_eq_cmat (moebius_circline_cmat_cmat M H) H' ∧ is_diag_circline_cmat H'"
by blast
qed
lemma wlog_circline_diag:
assumes "⋀ H. circline_diag H ⟹ P H"
"⋀ M H. P H ⟹ P (moebius_circline M H)"
shows "P H"
proof-
obtain M H' where "moebius_circline M H = H'" "circline_diag H'"
using circline_diagonalize[of H]
by auto
hence "P (moebius_circline M H)"
using assms(1)
by simp
thus ?thesis
using assms(2)[of "moebius_circline M H" "moebius_inv M"]
by simp
qed
subsubsection ‹Zero type circline set cardinality›
lemma circline_type_zero_card_eq1_0:
assumes "circline_type H = 0" and "0⇩h ∈ circline_set H"
shows "circline_set H = {0⇩h}"
using assms
unfolding circline_set_def
proof(safe)
fix z
assume "on_circline H z" "circline_type H = 0" "on_circline H 0⇩h"
hence "H = circline_point_0"
using unique_circline_type_zero_0'
unfolding circline_set_def
by simp
thus "z = 0⇩h"
using ‹on_circline H z›
by (transfer, transfer) (case_tac z, case_tac H, force simp add: vec_cnj_def)
qed
lemma circline_type_zero_card_eq1:
assumes "circline_type H = 0"
shows "∃ z. circline_set H = {z}"
proof-
have "∃ z. on_circline H z"
using assms
proof (transfer, transfer)
fix H
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
hence "C = cnj B" "is_real A" "is_real D"
using hh hermitean_elems[of A B C D]
by auto
assume "circline_type_cmat H = 0"
hence "mat_det H = 0"
by (simp add: complex_eq_if_Re_eq hh mat_det_hermitean_real sgn_eq_0_iff)
hence "A*D = B*C"
using HH
by simp
show "Bex {v. v ≠ vec_zero} (on_circline_cmat_cvec H)"
proof (cases "A ≠ 0 ∨ B ≠ 0")
case True
thus ?thesis
using HH ‹A*D = B*C›
by (rule_tac x="(-B, A)" in bexI) (auto simp add: Let_def vec_cnj_def field_simps)
next
case False
thus ?thesis
using HH ‹C = cnj B›
by (rule_tac x="(1, 0)" in bexI) (simp_all add: Let_def vec_cnj_def)
qed
qed
then obtain z where "on_circline H z"
by auto
obtain M where "moebius_pt M z = 0⇩h"
using ex_moebius_1[of z]
by auto
hence "0⇩h ∈ circline_set (moebius_circline M H)"
using on_circline_moebius_circline_I[OF ‹on_circline H z›, of M]
unfolding circline_set_def
by simp
hence "circline_set (moebius_circline M H) = {0⇩h}"
using circline_type_zero_card_eq1_0[of "moebius_circline M H"] ‹circline_type H = 0›
by auto
hence "circline_set H = {z}"
using ‹moebius_pt M z = 0⇩h›
using bij_moebius_pt[of M] bij_image_singleton[of "moebius_pt M" "circline_set H" _ z]
by simp
thus ?thesis
by auto
qed
subsubsection ‹Negative type circline set cardinality›
lemma quad_form_diagonal_iff:
assumes "k1 ≠ 0" and "is_real k1" and "is_real k2" and "Re k1 * Re k2 < 0"
shows "quad_form (z1, 1) (k1, 0, 0, k2) = 0 ⟷ (∃ φ. z1 = rcis (sqrt (Re (-k2 /k1))) φ)"
proof-
have "Re (-k2/k1) ≥ 0"
using ‹Re k1 * Re k2 < 0› ‹is_real k1› ‹is_real k2› ‹k1 ≠ 0›
using Re_divide_real[of k1 "-k2"]
by (smt divide_less_0_iff mult_nonneg_nonneg mult_nonpos_nonpos uminus_complex.simps(1))
have "quad_form (z1, 1) (k1, 0, 0, k2) = 0 ⟷ (cor (cmod z1))⇧2 = -k2 / k1"
using assms add_eq_0_iff[of k2 "k1*(cor (cmod z1))⇧2"]
using eq_divide_imp[of k1 "(cor (cmod z1))⇧2" "-k2"]
by (auto simp add: vec_cnj_def field_simps complex_mult_cnj_cmod)
also have "... ⟷ (cmod z1)⇧2 = Re (-k2 /k1)"
using assms
apply (subst complex_eq_if_Re_eq)
using Re_complex_of_real[of "(cmod z1)⇧2"] div_reals
by auto
also have "... ⟷ cmod z1 = sqrt (Re (-k2 /k1))"
by (metis norm_ge_zero real_sqrt_ge_0_iff real_sqrt_pow2 real_sqrt_power)
also have "... ⟷ (∃ φ. z1 = rcis (sqrt (Re (-k2 /k1))) φ)"
using rcis_cmod_arg[of z1, symmetric] assms abs_of_nonneg[of "sqrt (Re (-k2/k1))"]
using ‹Re (-k2/k1) ≥ 0›
by auto
finally show ?thesis
.
qed
lemma circline_type_neg_card_gt3_diag:
assumes "circline_type H < 0" and "circline_diag H"
shows "∃ A B C. A ≠ B ∧ A ≠ C ∧ B ≠ C ∧ {A, B, C} ⊆ circline_set H"
using assms
unfolding circline_set_def
apply (simp del: HOL.ex_simps)
proof (transfer, transfer)
fix H
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
hence HH_elems: "is_real A" "is_real D" "C = cnj B"
using hermitean_elems[of A B C D] hh
by auto
assume "circline_type_cmat H < 0" "is_diag_circline_cmat H"
hence "B = 0" "C = 0" "Re A * Re D < 0" "A ≠ 0"
using HH ‹is_real A› ‹is_real D›
by auto
let ?x = "sqrt (Re (- D / A))"
let ?A = "(rcis ?x 0, 1)"
let ?B = "(rcis ?x (pi/2), 1)"
let ?C = "(rcis ?x pi, 1)"
from quad_form_diagonal_iff[OF ‹A ≠ 0› ‹is_real A› ‹is_real D› ‹Re A * Re D < 0›]
have "quad_form ?A (A, 0, 0, D) = 0" "quad_form ?B (A, 0, 0, D) = 0" "quad_form ?C (A, 0, 0, D) = 0"
by (auto simp del: rcis_zero_arg)
hence "on_circline_cmat_cvec H ?A ∧ on_circline_cmat_cvec H ?B ∧ on_circline_cmat_cvec H ?C"
using HH ‹B = 0› ‹C = 0›
by simp
moreover
have "Re (D / A) < 0"
using ‹Re A * Re D < 0› ‹A ≠ 0› ‹is_real A› ‹is_real D›
using Re_divide_real[of A D]
by (metis Re_complex_div_lt_0 Re_mult_real div_reals eq_cnj_iff_real is_real_div)
hence "¬ ?A ≈⇩v ?B ∧ ¬ ?A ≈⇩v ?C ∧ ¬ ?B ≈⇩v ?C"
unfolding rcis_def
by (auto simp add: cis_def complex.corec)
moreover
have "?A ≠ vec_zero" "?B ≠ vec_zero" "?C ≠ vec_zero"
by auto
ultimately
show "∃A∈{v. v ≠ vec_zero}. ∃B∈{v. v ≠ vec_zero}. ∃C∈{v. v ≠ vec_zero}.
¬ A ≈⇩v B ∧ ¬ A ≈⇩v C ∧ ¬ B ≈⇩v C ∧
on_circline_cmat_cvec H A ∧ on_circline_cmat_cvec H B ∧ on_circline_cmat_cvec H C"
by blast
qed
lemma circline_type_neg_card_gt3:
assumes "circline_type H < 0"
shows "∃ A B C. A ≠ B ∧ A ≠ C ∧ B ≠ C ∧ {A, B, C} ⊆ circline_set H"
proof-
obtain M H' where "moebius_circline M H = H'" "circline_diag H'"
using circline_diagonalize[of H] assms
by auto
moreover
hence "circline_type H' < 0"
using assms moebius_preserve_circline_type
by auto
ultimately
obtain A B C where "A ≠ B" "A ≠ C" "B ≠ C" "{A, B, C} ⊆ circline_set H'"
using circline_type_neg_card_gt3_diag[of H']
by auto
let ?iM = "moebius_inv M"
have "moebius_circline ?iM H' = H"
using ‹moebius_circline M H = H'›[symmetric]
by simp
let ?A = "moebius_pt ?iM A" and ?B= "moebius_pt ?iM B" and ?C = "moebius_pt ?iM C"
have "?A ∈ circline_set H" "?B ∈ circline_set H" "?C ∈ circline_set H"
using ‹moebius_circline ?iM H' = H›[symmetric] ‹{A, B, C} ⊆ circline_set H'›
by simp_all
moreover
have "?A ≠ ?B" "?A ≠ ?C" "?B ≠ ?C"
using ‹A ≠ B› ‹A ≠ C› ‹B ≠ C›
by auto
ultimately
show ?thesis
by auto
qed
subsubsection ‹Positive type circline set cardinality›
lemma circline_type_pos_card_eq0_diag:
assumes "circline_diag H" and "circline_type H > 0"
shows "circline_set H = {}"
using assms
unfolding circline_set_def
apply simp
proof (transfer, transfer)
fix H
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
hence HH_elems: "is_real A" "is_real D" "C = cnj B"
using hermitean_elems[of A B C D] hh
by auto
assume "is_diag_circline_cmat H" "0 < circline_type_cmat H"
hence "B = 0" "C = 0" "Re A * Re D > 0" "A ≠ 0"
using HH ‹is_real A› ‹is_real D›
by auto
show "∀x∈{v. v ≠ vec_zero}. ¬ on_circline_cmat_cvec H x"
proof
fix x
assume "x ∈ {v. v ≠ vec_zero}"
obtain x1 x2 where xx: "x = (x1, x2)"
by (cases x, auto)
have "(Re A > 0 ∧ Re D > 0) ∨ (Re A < 0 ∧ Re D < 0)"
using ‹Re A * Re D > 0›
by (metis linorder_neqE_linordered_idom mult_eq_0_iff zero_less_mult_pos zero_less_mult_pos2)
moreover
have "(Re (x1 * cnj x1) ≥ 0 ∧ Re (x2 * cnj x2) > 0) ∨ (Re (x1 * cnj x1) > 0 ∧ Re (x2 * cnj x2) ≥ 0)"
using ‹x ∈ {v. v ≠ vec_zero}› xx
apply auto
apply (simp add: complex_neq_0 power2_eq_square)+
done
ultimately
have "Re A * Re (x1 * cnj x1) + Re D * Re (x2 * cnj x2) ≠ 0"
by (smt mult_neg_pos mult_nonneg_nonneg mult_nonpos_nonneg mult_pos_pos)
hence "A * (x1 * cnj x1) + D * (x2 * cnj x2) ≠ 0"
using ‹is_real A› ‹is_real D›
by (metis Re_mult_real plus_complex.simps(1) zero_complex.simps(1))
thus "¬ on_circline_cmat_cvec H x"
using HH ‹B = 0› ‹C = 0› xx
by (simp add: vec_cnj_def field_simps)
qed
qed
lemma circline_type_pos_card_eq0:
assumes "circline_type H > 0"
shows "circline_set H = {}"
proof-
obtain M H' where "moebius_circline M H = H'" "circline_diag H'"
using circline_diagonalize[of H] assms
by auto
moreover
hence "circline_type H' > 0"
using assms moebius_preserve_circline_type
by auto
ultimately
have "circline_set H' = {}"
using circline_type_pos_card_eq0_diag[of H']
by auto
let ?iM = "moebius_inv M"
have "moebius_circline ?iM H' = H"
using ‹moebius_circline M H = H'›[symmetric]
by simp
thus ?thesis
using ‹circline_set H' = {}›
by auto
qed
subsubsection ‹Cardinality determines type›
lemma card_eq1_circline_type_zero:
assumes "∃ z. circline_set H = {z}"
shows "circline_type H = 0"
proof (cases "circline_type H < 0")
case True
thus ?thesis
using circline_type_neg_card_gt3[of H] assms
by auto
next
case False
show ?thesis
proof (cases "circline_type H > 0")
case True
thus ?thesis
using circline_type_pos_card_eq0[of H] assms
by auto
next
case False
thus ?thesis
using ‹¬ (circline_type H) < 0›
by simp
qed
qed
subsubsection ‹Circline set is injective›
lemma inj_circline_set:
assumes "circline_set H = circline_set H'" and "circline_set H ≠ {}"
shows "H = H'"
proof (cases "circline_type H < 0")
case True
then obtain A B C where "A ≠ B" "A ≠ C" "B ≠ C" "{A, B, C} ⊆ circline_set H"
using circline_type_neg_card_gt3[of H]
by auto
hence "∃!H. A ∈ circline_set H ∧ B ∈ circline_set H ∧ C ∈ circline_set H"
using unique_circline_set[of A B C]
by simp
thus ?thesis
using ‹circline_set H = circline_set H'› ‹{A, B, C} ⊆ circline_set H›
by auto
next
case False
show ?thesis
proof (cases "circline_type H = 0")
case True
moreover
then obtain A where "{A} = circline_set H"
using circline_type_zero_card_eq1[of H]
by auto
moreover
hence "circline_type H' = 0"
using ‹circline_set H = circline_set H'› card_eq1_circline_type_zero[of H']
by auto
ultimately
show ?thesis
using unique_circline_type_zero[of A] ‹circline_set H = circline_set H'›
by auto
next
case False
hence "circline_type H > 0"
using ‹¬ (circline_type H < 0)›
by auto
thus ?thesis
using ‹circline_set H ≠ {}› circline_type_pos_card_eq0[of H]
by auto
qed
qed
subsection ‹Circline points - cross ratio real›
lemma four_points_on_circline_iff_cross_ratio_real:
assumes "distinct [z, u, v, w]"
shows "is_real (to_complex (cross_ratio z u v w)) ⟷
(∃ H. {z, u, v, w} ⊆ circline_set H)"
proof-
have "∀ z. distinct [z, u, v, w] ⟶ is_real (to_complex (cross_ratio z u v w)) ⟷ (∃ H. {z, u, v, w} ⊆ circline_set H)"
(is "?P u v w")
proof (rule wlog_moebius_01inf[of ?P u v w])
fix M a b c
assume aa: "?P a b c"
let ?Ma = "moebius_pt M a" and ?Mb = "moebius_pt M b" and ?Mc = "moebius_pt M c"
show "?P ?Ma ?Mb ?Mc"
proof (rule allI, rule impI)
fix z
obtain d where *: "z = moebius_pt M d"
using bij_moebius_pt[of M]
unfolding bij_def
by auto
let ?Md = "moebius_pt M d"
assume "distinct [z, moebius_pt M a, moebius_pt M b, moebius_pt M c]"
hence "distinct [a, b, c, d]"
using *
by auto
moreover
have "(∃ H. {d, a, b, c} ⊆ circline_set H) ⟷ (∃ H. {z, ?Ma, ?Mb, ?Mc} ⊆ circline_set H)"
using *
apply auto
apply (rule_tac x="moebius_circline M H" in exI, simp)
apply (rule_tac x="moebius_circline (moebius_inv M) H" in exI, simp)
done
ultimately
show "is_real (to_complex (cross_ratio z ?Ma ?Mb ?Mc)) = (∃H. {z, ?Ma, ?Mb, ?Mc} ⊆ circline_set H)"
using aa[rule_format, of d] *
by auto
qed
next
show "?P 0⇩h 1⇩h ∞⇩h"
proof safe
fix z
assume "distinct [z, 0⇩h, 1⇩h, ∞⇩h]"
hence "z ≠ ∞⇩h"
by auto
assume "is_real (to_complex (cross_ratio z 0⇩h 1⇩h ∞⇩h))"
hence "is_real (to_complex z)"
by simp
hence "z ∈ circline_set x_axis"
using of_complex_to_complex[symmetric, OF ‹z ≠ ∞⇩h›]
using circline_set_x_axis
by auto
thus "∃H. {z, 0⇩h, 1⇩h, ∞⇩h} ⊆ circline_set H"
by (rule_tac x=x_axis in exI, auto)
next
fix z H
assume *: "distinct [z, 0⇩h, 1⇩h, ∞⇩h]" "{z, 0⇩h, 1⇩h, ∞⇩h} ⊆ circline_set H"
hence "H = x_axis"
by auto
hence "z ∈ circline_set x_axis"
using *
by auto
hence "is_real (to_complex z)"
using * circline_set_x_axis
by auto
thus "is_real (to_complex (cross_ratio z 0⇩h 1⇩h ∞⇩h))"
by simp
qed
next
show "u ≠ v" "v ≠ w" "u ≠ w"
using assms
by auto
qed
thus ?thesis
using assms
by auto
qed
subsection ‹Symmetric points wrt. circline›
text ‹In the extended complex plane there are no substantial differences between circles and lines,
so we will consider only one kind of relation and call two points \emph{circline symmetric} if they
are mapped to one another using either reflection or inversion over arbitrary line or circle. Points
are symmetric iff the bilinear form of their representation vectors and matrix is zero.›
definition circline_symmetric_cvec_cmat :: "complex_vec ⇒ complex_vec ⇒ complex_mat ⇒ bool" where
[simp]: "circline_symmetric_cvec_cmat z1 z2 H ⟷ bilinear_form z1 z2 H = 0"
lift_definition circline_symmetric_hcoords_clmat :: "complex_homo_coords ⇒ complex_homo_coords ⇒ circline_mat ⇒ bool" is circline_symmetric_cvec_cmat
done
lift_definition circline_symmetric :: "complex_homo ⇒ complex_homo ⇒ circline ⇒ bool" is circline_symmetric_hcoords_clmat
apply transfer
apply (simp del: bilinear_form_def)
apply (erule exE)+
apply (simp add: bilinear_form_scale_m bilinear_form_scale_v1 bilinear_form_scale_v2 del: vec_cnj_sv quad_form_def bilinear_form_def)
done
lemma symmetry_principle [simp]:
assumes "circline_symmetric z1 z2 H"
shows "circline_symmetric (moebius_pt M z1) (moebius_pt M z2) (moebius_circline M H)"
using assms
by (transfer, transfer, simp del: bilinear_form_def congruence_def)
text ‹Symmetry wrt. @{term "unit_circle"}›
lemma circline_symmetric_0inf_disc [simp]:
shows "circline_symmetric 0⇩h ∞⇩h unit_circle"
by (transfer, transfer, simp add: vec_cnj_def)
lemma circline_symmetric_inv_homo_disc [simp]:
shows "circline_symmetric a (inversion a) unit_circle"
unfolding inversion_def
by (transfer, transfer) (case_tac a, auto simp add: vec_cnj_def)
lemma circline_symmetric_inv_homo_disc':
assumes "circline_symmetric a a' unit_circle"
shows "a' = inversion a"
unfolding inversion_def
using assms
proof (transfer, transfer)
fix a a'
assume vz: "a ≠ vec_zero" "a' ≠ vec_zero"
obtain a1 a2 where aa: "a = (a1, a2)"
by (cases a, auto)
obtain a1' a2' where aa': "a' = (a1', a2')"
by (cases a', auto)
assume *: "circline_symmetric_cvec_cmat a a' unit_circle_cmat"
show "a' ≈⇩v (conjugate_cvec ∘ reciprocal_cvec) a"
proof (cases "a1' = 0")
case True
thus ?thesis
using aa aa' vz *
by (auto simp add: vec_cnj_def field_simps)
next
case False
show ?thesis
proof (cases "a2 = 0")
case True
thus ?thesis
using ‹a1' ≠ 0›
using aa aa' * vz
by (simp add: vec_cnj_def field_simps)
next
case False
thus ?thesis
using ‹a1' ≠ 0› aa aa' *
by (simp add: vec_cnj_def field_simps) (rule_tac x="cnj a2 / a1'" in exI, simp add: field_simps)
qed
qed
qed
lemma ex_moebius_circline_x_axis:
assumes "circline_type H < 0"
shows "∃ M. moebius_circline M H = x_axis"
proof-
obtain A B C where *: "A ≠ B" "A ≠ C" "B ≠ C" "on_circline H A" "on_circline H B" "on_circline H C"
using circline_type_neg_card_gt3[OF assms]
unfolding circline_set_def
by auto
then obtain M where "moebius_pt M A = 0⇩h" "moebius_pt M B = 1⇩h" "moebius_pt M C = ∞⇩h"
using ex_moebius_01inf by blast
hence "moebius_circline M H = x_axis"
using *
by (metis circline_set_I circline_set_moebius_circline rev_image_eqI unique_circline_01inf')
thus ?thesis
by blast
qed
lemma wlog_circline_x_axis:
assumes "circline_type H < 0"
assumes "⋀ M H. P H ⟹ P (moebius_circline M H)"
assumes "P x_axis"
shows "P H"
proof-
obtain M where "moebius_circline M H = x_axis"
using ex_moebius_circline_x_axis[OF assms(1)]
by blast
then obtain M' where "moebius_circline M' x_axis = H"
by (metis moebius_circline_comp_inv_left)
thus ?thesis
using assms(2)[of x_axis M'] assms(3)
by simp
qed
lemma circline_intersection_at_most_2_points:
assumes "H1 ≠ H2"
shows "finite (circline_intersection H1 H2) ∧ card (circline_intersection H1 H2) ≤ 2"
proof (rule ccontr)
assume "¬ ?thesis"
hence "infinite (circline_intersection H1 H2) ∨ card (circline_intersection H1 H2) > 2"
by auto
hence "∃ A B C. A ≠ B ∧ B ≠ C ∧ A ≠ C ∧ {A, B, C} ⊆ circline_intersection H1 H2"
proof
assume "card (circline_intersection H1 H2) > 2"
thus ?thesis
using card_geq_3_iff_contains_3_elems[of "circline_intersection H1 H2"]
by auto
next
assume "infinite (circline_intersection H1 H2)"
thus ?thesis
using infinite_contains_3_elems
by blast
qed
then obtain A B C where "A ≠ B" "B ≠ C" "A ≠ C" "{A, B, C} ⊆ circline_intersection H1 H2"
by blast
hence "H2 = H1"
using circline_intersection_def mem_Collect_eq unique_circline_set by fastforce
thus False
using assms
by simp
qed
end
Theory Oriented_Circlines
section ‹Oriented circlines›
theory Oriented_Circlines
imports Circlines
begin
subsection ‹Oriented circlines definition›
text ‹In this section we describe how the orientation is introduced for the circlines. Similarly as
the set of circline points, the set of disc points is introduced using the quadratic form induced by
the circline matrix --- the set of points of the circline disc is the set of points such that
satisfy that $A\cdot z\cdot \overline{z} + B\cdot \overline{z} + C\cdot z + D < 0$, where
$(A, B, C, D)$ is a circline matrix representative Hermitean matrix. As the
set of disc points must be invariant to the choice of representative, it is clear that oriented
circlines matrices are equivalent only if they are proportional by a positive real factor (recall
that unoriented circline allowed arbitrary non-zero real factors).›
definition ocircline_eq_cmat :: "complex_mat ⇒ complex_mat ⇒ bool" where
[simp]: "ocircline_eq_cmat A B ⟷(∃ k::real. k > 0 ∧ B = cor k *⇩s⇩m A)"
lift_definition ocircline_eq_clmat :: "circline_mat ⇒ circline_mat ⇒ bool" is ocircline_eq_cmat
done
lemma ocircline_eq_cmat_id [simp]:
shows "ocircline_eq_cmat H H"
by (simp, rule_tac x=1 in exI, simp)
quotient_type ocircline = circline_mat / ocircline_eq_clmat
proof (rule equivpI)
show "reflp ocircline_eq_clmat"
unfolding reflp_def
by transfer (auto, rule_tac x="1" in exI, simp)
next
show "symp ocircline_eq_clmat"
unfolding symp_def
by transfer (simp only: ocircline_eq_cmat_def, safe, rule_tac x="1/k" in exI, simp)
next
show "transp ocircline_eq_clmat"
unfolding transp_def
by transfer (simp only: ocircline_eq_cmat_def, safe, rule_tac x="k*ka" in exI, simp)
qed
subsection ‹Points on oriented circlines›
text ‹Boundary of the circline.›
lift_definition on_ocircline :: "ocircline ⇒ complex_homo ⇒ bool" is on_circline_clmat_hcoords
by transfer (simp del: quad_form_def, (erule exE)+, simp add: quad_form_scale_m quad_form_scale_v del: quad_form_def)
definition ocircline_set :: "ocircline ⇒ complex_homo set" where
"ocircline_set H = {z. on_ocircline H z}"
lemma ocircline_set_I [simp]:
assumes "on_ocircline H z"
shows "z ∈ ocircline_set H"
using assms
unfolding ocircline_set_def
by simp
subsection ‹Disc and disc complement - in and out points›
text ‹Interior and the exterior of an oriented circline.›
definition in_ocircline_cmat_cvec :: "complex_mat ⇒ complex_vec ⇒ bool" where
[simp]: "in_ocircline_cmat_cvec H z ⟷ Re (quad_form z H) < 0"
lift_definition in_ocircline_clmat_hcoords :: "circline_mat ⇒ complex_homo_coords ⇒ bool" is in_ocircline_cmat_cvec
done
lift_definition in_ocircline :: "ocircline ⇒ complex_homo ⇒ bool" is in_ocircline_clmat_hcoords
proof transfer
fix H H' z z'
assume hh: "hermitean H ∧ H ≠ mat_zero" and "hermitean H' ∧ H' ≠ mat_zero" and
"z ≠ vec_zero" and "z' ≠ vec_zero"
assume "ocircline_eq_cmat H H'" and "z ≈⇩v z'"
then obtain k k' where
*: "0 < k" "H' = cor k *⇩s⇩m H" "k' ≠ 0" "z' = k' *⇩s⇩v z"
by auto
hence "quad_form z' H' = cor k * cor ((cmod k')⇧2) * quad_form z H"
by (simp add: quad_form_scale_v quad_form_scale_m del: vec_cnj_sv quad_form_def)
hence "Re (quad_form z' H') = k * (cmod k')⇧2 * Re (quad_form z H)"
using hh quad_form_hermitean_real[of H]
by (simp add: power2_eq_square)
thus "in_ocircline_cmat_cvec H z = in_ocircline_cmat_cvec H' z'"
using ‹k > 0› ‹k' ≠ 0›
using mult_less_0_iff
by fastforce
qed
definition disc :: "ocircline ⇒ complex_homo set" where
"disc H = {z. in_ocircline H z}"
lemma disc_I [simp]:
assumes "in_ocircline H z"
shows "z ∈ disc H"
using assms
unfolding disc_def
by simp
definition out_ocircline_cmat_cvec :: "complex_mat ⇒ complex_vec ⇒ bool" where
[simp]: "out_ocircline_cmat_cvec H z ⟷ Re (quad_form z H) > 0"
lift_definition out_ocircline_clmat_hcoords :: "circline_mat ⇒ complex_homo_coords ⇒ bool" is out_ocircline_cmat_cvec
done
lift_definition out_ocircline :: "ocircline ⇒ complex_homo ⇒ bool" is out_ocircline_clmat_hcoords
proof transfer
fix H H' z z'
assume hh: "hermitean H ∧ H ≠ mat_zero" "hermitean H' ∧ H' ≠ mat_zero"
"z ≠ vec_zero" "z' ≠ vec_zero"
assume "ocircline_eq_cmat H H'" "z ≈⇩v z'"
then obtain k k' where
*: "0 < k" "H' = cor k *⇩s⇩m H" "k' ≠ 0" "z' = k' *⇩s⇩v z"
by auto
hence "quad_form z' H' = cor k * cor ((cmod k')⇧2) * quad_form z H"
by (simp add: quad_form_scale_v quad_form_scale_m del: vec_cnj_sv quad_form_def)
hence "Re (quad_form z' H') = k * (cmod k')⇧2 * Re (quad_form z H)"
using hh quad_form_hermitean_real[of H]
by (simp add: power2_eq_square)
thus "out_ocircline_cmat_cvec H z = out_ocircline_cmat_cvec H' z'"
using ‹k > 0› ‹k' ≠ 0›
using zero_less_mult_pos
by fastforce
qed
definition disc_compl :: "ocircline ⇒ complex_homo set" where
"disc_compl H = {z. out_ocircline H z}"
text ‹These three sets are mutually disjoint and they fill up the entire plane.›
lemma disc_compl_I [simp]:
assumes "out_ocircline H z"
shows "z ∈ disc_compl H"
using assms
unfolding disc_compl_def
by simp
lemma in_on_out:
shows "in_ocircline H z ∨ on_ocircline H z ∨ out_ocircline H z"
apply (transfer, transfer)
using quad_form_hermitean_real
using complex_eq_if_Re_eq
by auto
lemma in_on_out_univ:
shows "disc H ∪ disc_compl H ∪ ocircline_set H = UNIV"
unfolding disc_def disc_compl_def ocircline_set_def
using in_on_out[of H]
by auto
lemma disc_inter_disc_compl [simp]:
shows "disc H ∩ disc_compl H = {}"
unfolding disc_def disc_compl_def
by auto (transfer, transfer, simp)
lemma disc_inter_ocircline_set [simp]:
shows "disc H ∩ ocircline_set H = {}"
unfolding disc_def ocircline_set_def
by auto (transfer, transfer, simp)
lemma disc_compl_inter_ocircline_set [simp]:
shows "disc_compl H ∩ ocircline_set H = {}"
unfolding disc_compl_def ocircline_set_def
by auto (transfer, transfer, simp)
subsection ‹Opposite orientation›
text ‹Finding opposite circline is idempotent, and opposite circlines share the same set of points,
but exchange disc and its complement.›
definition opposite_ocircline_cmat :: "complex_mat ⇒ complex_mat" where
[simp]: "opposite_ocircline_cmat H = (-1) *⇩s⇩m H"
lift_definition opposite_ocircline_clmat :: "circline_mat ⇒ circline_mat" is opposite_ocircline_cmat
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition opposite_ocircline :: "ocircline ⇒ ocircline" is opposite_ocircline_clmat
by transfer auto
lemma opposite_ocircline_involution [simp]:
shows "opposite_ocircline (opposite_ocircline H) = H"
by (transfer, transfer) (auto, rule_tac x="1" in exI, simp)
lemma on_circline_opposite_ocircline_cmat [simp]:
assumes "hermitean H ∧ H ≠ mat_zero" and "z ≠ vec_zero"
shows "on_circline_cmat_cvec (opposite_ocircline_cmat H) z = on_circline_cmat_cvec H z"
using assms
by (simp add: quad_form_scale_m del: quad_form_def)
lemma on_circline_opposite_ocircline [simp]:
shows "on_ocircline (opposite_ocircline H) z ⟷ on_ocircline H z"
using on_circline_opposite_ocircline_cmat
by (transfer, transfer, simp)
lemma ocircline_set_opposite_ocircline [simp]:
shows "ocircline_set (opposite_ocircline H) = ocircline_set H"
unfolding ocircline_set_def
by auto
lemma disc_compl_opposite_ocircline [simp]:
shows "disc_compl (opposite_ocircline H) = disc H"
unfolding disc_def disc_compl_def
apply auto
apply (transfer, transfer)
apply (auto simp add: quad_form_scale_m simp del: quad_form_def)
apply (transfer ,transfer)
apply (auto simp add: quad_form_scale_m simp del: quad_form_def)
done
lemma disc_opposite_ocircline [simp]:
shows "disc (opposite_ocircline H) = disc_compl H"
using disc_compl_opposite_ocircline[of "opposite_ocircline H"]
by simp
subsection ‹Positive orientation. Conversion between unoriented and oriented circlines›
text ‹Given an oriented circline, one can trivially obtain its unoriented counterpart, and these two
share the same set of points.›
lift_definition of_ocircline :: "ocircline ⇒ circline" is "id::circline_mat ⇒ circline_mat"
by transfer (simp, erule exE, force)
lemma of_ocircline_opposite_ocircline [simp]:
shows "of_ocircline (opposite_ocircline H) = of_ocircline H"
by (transfer, transfer) (simp, erule exE, rule_tac x="-1" in exI, simp)
lemma on_ocircline_of_circline [simp]:
shows "on_circline (of_ocircline H) z ⟷ on_ocircline H z"
by (transfer, transfer, simp)
lemma circline_set_of_ocircline [simp]:
shows "circline_set (of_ocircline H) = ocircline_set H"
unfolding ocircline_set_def circline_set_def
by (safe) (transfer, simp)+
lemma inj_of_ocircline:
assumes "of_ocircline H = of_ocircline H'"
shows "H = H' ∨ H = opposite_ocircline H'"
using assms
by (transfer, transfer) (simp, metis linorder_neqE_linordered_idom minus_of_real_eq_of_real_iff mult_minus1 mult_sm_distribution neg_0_equal_iff_equal neg_less_0_iff_less)
lemma inj_ocircline_set:
assumes "ocircline_set H = ocircline_set H'" and "ocircline_set H ≠ {}"
shows "H = H' ∨ H = opposite_ocircline H'"
proof-
from assms
have "circline_set (of_ocircline H) = circline_set (of_ocircline H')"
"circline_set (of_ocircline H') ≠ {}"
by auto
hence "of_ocircline H = of_ocircline H'"
by (simp add: inj_circline_set)
thus ?thesis
by (rule inj_of_ocircline)
qed
text ‹Positive orientation.›
text ‹Given a representative Hermitean matrix of a circline, it represents exactly one of the two
possible oriented circlines. The choice of what should be called a positive orientation is
arbitrary. We follow Schwerdtfeger \cite{schwerdtfeger}, use the leading coefficient $A$ as the
first criterion, and say that circline matrices with $A > 0$ are called positively oriented, and
with $A < 0$ negatively oriented. However, Schwerdtfeger did not discuss the possible case of $A =
0$ (the case of lines), so we had to extend his definition to achieve a total characterization.›
definition pos_oriented_cmat :: "complex_mat ⇒ bool" where
[simp]: "pos_oriented_cmat H ⟷
(let (A, B, C, D) = H
in (Re A > 0 ∨ (Re A = 0 ∧ ((B ≠ 0 ∧ arg B > 0) ∨ (B = 0 ∧ Re D > 0)))))"
lift_definition pos_oriented_clmat :: "circline_mat ⇒ bool" is pos_oriented_cmat
done
lift_definition pos_oriented :: "ocircline ⇒ bool" is pos_oriented_clmat
by transfer
(case_tac circline_mat1, case_tac circline_mat2, simp, erule exE, simp,
metis mult_pos_pos zero_less_mult_pos)
lemma pos_oriented:
shows "pos_oriented H ∨ pos_oriented (opposite_ocircline H)"
proof (transfer, transfer)
fix H
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
moreover
hence "Re A = 0 ∧ Re D = 0 ⟶ B ≠ 0"
using hh hermitean_elems[of A B C D]
by (cases A, cases D) (auto simp add: Complex_eq)
moreover
have "B ≠ 0 ∧ ¬ 0 < arg B ⟶ 0 < arg (- B)"
using canon_ang_plus_pi2[of "arg B"] arg_bounded[of B]
by (auto simp add: arg_uminus)
ultimately
show "pos_oriented_cmat H ∨ pos_oriented_cmat (opposite_ocircline_cmat H)"
by auto
qed
lemma pos_oriented_opposite_ocircline_cmat [simp]:
assumes "hermitean H ∧ H ≠ mat_zero"
shows "pos_oriented_cmat (opposite_ocircline_cmat H) ⟷ ¬ pos_oriented_cmat H"
proof-
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
moreover
hence "Re A = 0 ∧ Re D = 0 ⟶ B ≠ 0"
using assms hermitean_elems[of A B C D]
by (cases A, cases D) (auto simp add: Complex_eq)
moreover
have "B ≠ 0 ∧ ¬ 0 < arg B ⟶ 0 < arg (- B)"
using canon_ang_plus_pi2[of "arg B"] arg_bounded[of B]
by (auto simp add: arg_uminus)
moreover
have "B ≠ 0 ∧ 0 < arg B ⟶ ¬ 0 < arg (- B)"
using canon_ang_plus_pi1[of "arg B"] arg_bounded[of B]
by (auto simp add: arg_uminus)
ultimately
show "pos_oriented_cmat (opposite_ocircline_cmat H) = (¬ pos_oriented_cmat H)"
by simp (metis not_less_iff_gr_or_eq)
qed
lemma pos_oriented_opposite_ocircline [simp]:
shows "pos_oriented (opposite_ocircline H) ⟷ ¬ pos_oriented H"
using pos_oriented_opposite_ocircline_cmat
by (transfer, transfer, simp)
lemma pos_oriented_circle_inf:
assumes "∞⇩h ∉ ocircline_set H"
shows "pos_oriented H ⟷ ∞⇩h ∉ disc H"
using assms
unfolding ocircline_set_def disc_def
apply simp
proof (transfer, transfer)
fix H
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
hence "is_real A"
using hh hermitean_elems
by auto
assume "¬ on_circline_cmat_cvec H ∞⇩v"
thus "pos_oriented_cmat H = (¬ in_ocircline_cmat_cvec H ∞⇩v)"
using HH ‹is_real A›
by (cases A) (auto simp add: vec_cnj_def Complex_eq)
qed
lemma pos_oriented_euclidean_circle:
assumes "is_circle (of_ocircline H)"
"(a, r) = euclidean_circle (of_ocircline H)"
"circline_type (of_ocircline H) < 0"
shows "pos_oriented H ⟷ of_complex a ∈ disc H"
using assms
unfolding disc_def
apply simp
proof (transfer, transfer)
fix H a r
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
hence "is_real A" "is_real D" "C = cnj B"
using hh hermitean_elems
by auto
assume *: "¬ circline_A0_cmat (id H)" "(a, r) = euclidean_circle_cmat (id H)" "circline_type_cmat (id H) < 0"
hence "A ≠ 0" "Re A ≠ 0"
using HH ‹is_real A›
by (case_tac[!] A) (auto simp add: Complex_eq)
have "Re (A*D - B*C) < 0"
using ‹circline_type_cmat (id H) < 0› HH
by simp
have **: "(A * (D * cnj A) - B * (C * cnj A)) / (A * cnj A) = (A*D - B*C) / A"
using ‹A ≠ 0›
by (simp add: field_simps)
hence ***: "0 < Re A ⟷ Re ((A * (D * cnj A) - B * (C * cnj A)) / (A * cnj A)) < 0"
using ‹is_real A› ‹A ≠ 0› ‹Re (A*D - B*C) < 0›
by (simp add: Re_divide_real divide_less_0_iff)
have "Re D - Re (cnj B * B / cnj A) < Re ((C - cnj B * A / cnj A) * B / A)" if "Re A > 0"
using HH * ‹is_real A› that
by simp (smt "**" "***" cnj.simps(1) cnj.simps(2) complex_eq diff_divide_distrib left_diff_distrib'
minus_complex.simps(1) mult.commute nonzero_mult_div_cancel_right)?
moreover have "Re A > 0" if "Re D - Re (cnj B * B / cnj A) < Re ((C - cnj B * A / cnj A) * B / A)"
using HH * ‹is_real A› that
by simp (smt "**" "***" cnj.simps(1) cnj.simps(2) complex_eq diff_divide_distrib left_diff_distrib'
minus_complex.simps(1) mult.commute nonzero_mult_div_cancel_right)?
ultimately show "pos_oriented_cmat H = in_ocircline_cmat_cvec H (of_complex_cvec a)"
using HH ‹Re A ≠ 0› * ‹is_real A› by (auto simp add: vec_cnj_def)
qed
text ‹Introduce positive orientation›
definition of_circline_cmat :: "complex_mat ⇒ complex_mat" where
[simp]: "of_circline_cmat H = (if pos_oriented_cmat H then H else opposite_ocircline_cmat H)"
lift_definition of_circline_clmat :: "circline_mat ⇒ circline_mat" is of_circline_cmat
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lemma of_circline_clmat_def':
shows "of_circline_clmat H = (if pos_oriented_clmat H then H else opposite_ocircline_clmat H)"
by transfer simp
lemma pos_oriented_cmat_mult_positive':
assumes
"hermitean H1 ∧ H1 ≠ mat_zero" and
"hermitean H2 ∧ H2 ≠ mat_zero" and
"∃k. k > 0 ∧ H2 = cor k *⇩s⇩m H1" and
"pos_oriented_cmat H1"
shows "pos_oriented_cmat H2"
proof-
obtain A1 B1 C1 D1 A2 B2 C2 D2
where HH: "H1 = (A1, B1, C1, D1)" "H2 = (A2, B2, C2, D2)"
by (cases H1, cases H2)
thus ?thesis
using assms
by fastforce
qed
lemma pos_oriented_cmat_mult_positive:
assumes
"hermitean H1 ∧ H1 ≠ mat_zero" and
"hermitean H2 ∧ H2 ≠ mat_zero" and
"∃k. k > 0 ∧ H2 = cor k *⇩s⇩m H1"
shows
"pos_oriented_cmat H1 ⟷ pos_oriented_cmat H2"
proof-
from assms(3) obtain k where "k > 0 ∧ H2 = cor k *⇩s⇩m H1"
by auto
hence "∃k. k > 0 ∧ H1 = cor k *⇩s⇩m H2"
by (rule_tac x="1/k" in exI, auto)
thus ?thesis
using assms pos_oriented_cmat_mult_positive'
by blast
qed
lemma pos_oriented_cmat_mult_negative:
assumes
"hermitean H1 ∧ H1 ≠ mat_zero" and
"hermitean H2 ∧ H2 ≠ mat_zero" and
"∃k. k < 0 ∧ H2 = cor k *⇩s⇩m H1"
shows
"pos_oriented_cmat H1 ⟷ ¬ pos_oriented_cmat H2"
using assms
proof-
obtain A B C D A1 B1 C1 D1
where *: "H1 = (A, B, C, D)" "H2 = (A1, B1, C1, D1)"
by (cases H1, cases H2) auto
hence **: "is_real A" "is_real D" "is_real A1" "is_real D1" "B = 0 ⟷ C = 0" "B1 = 0 ⟷ C1 = 0"
using assms hermitean_elems[of A B C D] hermitean_elems[of A1 B1 C1 D1]
by auto
show ?thesis
proof (rule iffI)
assume H1: "pos_oriented_cmat H1"
show "¬ pos_oriented_cmat H2"
proof (cases "Re A > 0")
case True
thus ?thesis
using assms * ** mult_neg_pos
by fastforce
next
case False
show ?thesis
proof (cases "B = 0")
case True
thus ?thesis
using assms * ** H1 ‹¬ Re A > 0› mult_neg_pos
by fastforce
next
case False
thus ?thesis
using arg_uminus_opposite_sign[of B] arg_mult_real_negative
using assms * ** H1 ‹¬ Re A > 0› mult_neg_pos
by fastforce
qed
qed
next
assume H2: "¬ pos_oriented_cmat H2"
show "pos_oriented_cmat H1"
proof (cases "Re A > 0")
case True
thus ?thesis
using * ** mult_neg_pos
by fastforce
next
case False
show ?thesis
proof (cases "B = 0")
case True
thus ?thesis
using assms * ** H2 ‹¬ Re A > 0›
by simp (smt arg_0_iff arg_complex_of_real_negative arg_complex_of_real_positive arg_mult_eq complex_of_real_Re mult.right_neutral mult_eq_0_iff of_real_0 of_real_1 zero_complex.simps(1))
next
case False
thus ?thesis
using assms ‹¬ Re A > 0› H2 * **
using arg_uminus_opposite_sign[of B]
by (cases "Re A = 0", auto simp add: mult_neg_neg)
qed
qed
qed
qed
lift_definition of_circline :: "circline ⇒ ocircline" is of_circline_clmat
proof transfer
fix H1 H2
assume hh:
"hermitean H1 ∧ H1 ≠ mat_zero"
"hermitean H2 ∧ H2 ≠ mat_zero"
assume "circline_eq_cmat H1 H2"
then obtain k where *: "k ≠ 0 ∧ H2 = cor k *⇩s⇩m H1"
by auto
show "ocircline_eq_cmat (of_circline_cmat H1) (of_circline_cmat H2)"
proof (cases "k > 0")
case True
hence "pos_oriented_cmat H1 = pos_oriented_cmat H2"
using * pos_oriented_cmat_mult_positive[OF hh]
by blast
thus ?thesis
using hh * ‹k > 0›
apply (simp del: pos_oriented_cmat_def)
apply (rule conjI)
apply (rule impI)
apply (simp, rule_tac x=k in exI, simp)
apply (rule impI)
apply (simp, rule_tac x=k in exI, simp)
done
next
case False
hence "k < 0"
using *
by simp
hence "pos_oriented_cmat H1 ⟷ ¬ (pos_oriented_cmat H2)"
using * pos_oriented_cmat_mult_negative[OF hh]
by blast
thus ?thesis
using hh * ‹k < 0›
apply (simp del: pos_oriented_cmat_def)
apply (rule conjI)
apply (rule impI)
apply (simp, rule_tac x="-k" in exI, simp)
apply (rule impI)
apply (simp, rule_tac x="-k" in exI, simp)
done
qed
qed
lemma pos_oriented_of_circline [simp]:
shows "pos_oriented (of_circline H)"
using pos_oriented_opposite_ocircline_cmat
by (transfer, transfer, simp)
lemma of_ocircline_of_circline [simp]:
shows "of_ocircline (of_circline H) = H"
apply (transfer, auto simp add: of_circline_clmat_def')
apply (transfer, simp, rule_tac x="-1" in exI, simp)
done
lemma of_circline_of_ocircline_pos_oriented [simp]:
assumes "pos_oriented H"
shows "of_circline (of_ocircline H) = H"
using assms
by (transfer, transfer, simp, rule_tac x=1 in exI, simp)
lemma inj_of_circline:
assumes "of_circline H = of_circline H'"
shows "H = H'"
using assms
proof (transfer, transfer)
fix H H'
assume "ocircline_eq_cmat (of_circline_cmat H) (of_circline_cmat H')"
then obtain k where "k > 0" "of_circline_cmat H' = cor k *⇩s⇩m of_circline_cmat H"
by auto
thus "circline_eq_cmat H H'"
using mult_sm_inv_l[of "-1" "H'" "cor k *⇩s⇩m H"]
using mult_sm_inv_l[of "-1" "H'" "(- (cor k)) *⇩s⇩m H"]
apply (simp split: if_split_asm)
apply (rule_tac x="k" in exI, simp)
apply (rule_tac x="-k" in exI, simp)
apply (rule_tac x="-k" in exI, simp)
apply (rule_tac x="k" in exI, simp)
done
qed
lemma of_circline_of_ocircline:
shows "of_circline (of_ocircline H') = H' ∨
of_circline (of_ocircline H') = opposite_ocircline H'"
proof (cases "pos_oriented H'")
case True
thus ?thesis
by auto
next
case False
hence "pos_oriented (opposite_ocircline H')"
using pos_oriented
by auto
thus ?thesis
using of_ocircline_opposite_ocircline[of H']
using of_circline_of_ocircline_pos_oriented [of "opposite_ocircline H'"]
by auto
qed
subsubsection ‹Set of points on oriented and unoriented circlines›
lemma ocircline_set_of_circline [simp]:
shows "ocircline_set (of_circline H) = circline_set H"
unfolding ocircline_set_def circline_set_def
proof (safe)
fix z
assume "on_ocircline (of_circline H) z"
thus "on_circline H z"
by (transfer, transfer, simp del: on_circline_cmat_cvec_def opposite_ocircline_cmat_def split: if_split_asm)
next
fix z
assume "on_circline H z"
thus "on_ocircline (of_circline H) z"
by (transfer, transfer, simp del: on_circline_cmat_cvec_def opposite_ocircline_cmat_def split: if_split_asm)
qed
subsection ‹Some special oriented circlines and discs›
lift_definition mk_ocircline :: "complex ⇒ complex ⇒ complex ⇒ complex ⇒ ocircline" is mk_circline_clmat
done
text ‹oriented unit circle and unit disc›
lift_definition ounit_circle :: "ocircline" is unit_circle_clmat
done
lemma pos_oriented_ounit_circle [simp]:
shows "pos_oriented ounit_circle"
by (transfer, transfer, simp)
lemma of_ocircline_ounit_circle [simp]:
shows "of_ocircline ounit_circle = unit_circle"
by (transfer, transfer, simp)
lemma of_circline_unit_circle [simp]:
shows "of_circline (unit_circle) = ounit_circle"
by (transfer, transfer, simp)
lemma ocircline_set_ounit_circle [simp]:
shows "ocircline_set ounit_circle = circline_set unit_circle"
apply (subst of_circline_unit_circle[symmetric])
apply (subst ocircline_set_of_circline)
apply simp
done
definition unit_disc :: "complex_homo set" where
"unit_disc = disc ounit_circle"
definition unit_disc_compl :: "complex_homo set" where
"unit_disc_compl = disc_compl ounit_circle"
definition unit_circle_set :: "complex_homo set" where
"unit_circle_set = circline_set unit_circle"
lemma zero_in_unit_disc [simp]:
shows "0⇩h ∈ unit_disc"
unfolding unit_disc_def disc_def
by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def)
lemma one_notin_unit_dic [simp]:
shows "1⇩h ∉ unit_disc"
unfolding unit_disc_def disc_def
by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def)
lemma inf_notin_unit_disc [simp]:
shows "∞⇩h ∉ unit_disc"
unfolding unit_disc_def disc_def
by (simp, transfer, transfer) (simp add: Let_def vec_cnj_def)
lemma unit_disc_iff_cmod_lt_1 [simp]:
shows "of_complex c ∈ unit_disc ⟷ cmod c < 1"
unfolding unit_disc_def disc_def
by (simp, transfer, transfer, simp add: vec_cnj_def cmod_def power2_eq_square)
lemma unit_disc_cmod_square_lt_1 [simp]:
assumes "z ∈ unit_disc"
shows "(cmod (to_complex z))⇧2 < 1"
using assms inf_or_of_complex[of z]
by (auto simp add: abs_square_less_1)
lemma unit_disc_to_complex_inj:
assumes "u ∈ unit_disc" and "v ∈ unit_disc"
assumes "to_complex u = to_complex v"
shows "u = v"
using assms
using inf_or_of_complex[of u] inf_or_of_complex[of v]
by auto
lemma inversion_unit_disc [simp]:
shows "inversion ` unit_disc = unit_disc_compl"
unfolding unit_disc_def unit_disc_compl_def disc_def disc_compl_def
proof safe
fix x
assume "in_ocircline ounit_circle x"
thus "out_ocircline ounit_circle (inversion x)"
unfolding inversion_def
by (transfer, transfer, auto simp add: vec_cnj_def)
next
fix x
assume *: "out_ocircline ounit_circle x"
show "x ∈ inversion ` Collect (in_ocircline ounit_circle)"
proof (rule image_eqI)
show "x = inversion (inversion x)"
by auto
next
show "inversion x ∈ Collect (in_ocircline ounit_circle)"
using *
unfolding inversion_def
by (simp, transfer, transfer, auto simp add: vec_cnj_def)
qed
qed
lemma inversion_unit_disc_compl [simp]:
shows "inversion ` unit_disc_compl = unit_disc"
proof-
have "inversion ` (inversion ` unit_disc) = unit_disc"
by (auto simp del: inversion_unit_disc simp add: image_iff)
thus ?thesis
by simp
qed
lemma inversion_noteq_unit_disc:
assumes "u ∈ unit_disc" and "v ∈ unit_disc"
shows "inversion u ≠ v"
proof-
from assms
have "inversion u ∈ unit_disc_compl"
by (metis image_eqI inversion_unit_disc)
thus ?thesis
using assms
unfolding unit_disc_def unit_disc_compl_def
using disc_inter_disc_compl
by fastforce
qed
lemma in_ocircline_ounit_circle_conjugate [simp]:
assumes "in_ocircline ounit_circle z"
shows "in_ocircline ounit_circle (conjugate z)"
using assms
by (transfer, transfer, auto simp add: vec_cnj_def)
lemma conjugate_unit_disc [simp]:
shows "conjugate ` unit_disc = unit_disc"
unfolding unit_disc_def disc_def
apply (auto simp add: image_iff)
apply (rule_tac x="conjugate x" in exI, simp)
done
lemma conjugate_in_unit_disc [simp]:
assumes "z ∈ unit_disc"
shows "conjugate z ∈ unit_disc"
using conjugate_unit_disc
using assms
by blast
lemma out_ocircline_ounit_circle_conjugate [simp]:
assumes "out_ocircline ounit_circle z"
shows "out_ocircline ounit_circle (conjugate z)"
using assms
by (transfer, transfer, auto simp add: vec_cnj_def)
lemma conjugate_unit_disc_compl [simp]:
shows "conjugate ` unit_disc_compl = unit_disc_compl"
unfolding unit_disc_compl_def disc_compl_def
apply (auto simp add: image_iff)
apply (rule_tac x="conjugate x" in exI, simp)
done
lemma conjugate_in_unit_disc_compl [simp]:
assumes "z ∈ unit_disc_compl"
shows "conjugate z ∈ unit_disc_compl"
using conjugate_unit_disc_compl
using assms
by blast
subsubsection ‹Oriented x axis and lower half plane›
lift_definition o_x_axis :: "ocircline" is x_axis_clmat
done
lemma o_x_axis_pos_oriented [simp]:
shows "pos_oriented o_x_axis"
by (transfer, transfer, simp)
lemma of_ocircline_o_x_axis [simp]:
shows "of_ocircline o_x_axis = x_axis"
by (transfer, transfer, simp)
lemma of_circline_x_axis [simp]:
shows "of_circline x_axis = o_x_axis"
using of_circline_of_ocircline_pos_oriented[of o_x_axis]
using o_x_axis_pos_oriented
by simp
lemma ocircline_set_circline_set_x_axis [simp]:
shows "ocircline_set o_x_axis = circline_set x_axis"
by (subst of_circline_x_axis[symmetric], subst ocircline_set_of_circline, simp)
lemma ii_in_disc_o_x_axis [simp]:
shows "ii⇩h ∉ disc o_x_axis"
unfolding disc_def
by simp (transfer, transfer, simp add: Let_def vec_cnj_def)
lemma ii_notin_disc_o_x_axis [simp]:
shows "ii⇩h ∈ disc_compl o_x_axis"
unfolding disc_compl_def
by simp (transfer, transfer, simp add: Let_def vec_cnj_def)
lemma of_complex_in_o_x_axis_disc [simp]:
shows "of_complex z ∈ disc o_x_axis ⟷ Im z < 0"
unfolding disc_def
by auto (transfer, transfer, simp add: vec_cnj_def)+
lemma inf_notin_disc_o_x_axis [simp]:
shows "∞⇩h ∉ disc o_x_axis"
unfolding disc_def
by simp (transfer, transfer, simp add: vec_cnj_def)
lemma disc_o_x_axis:
shows "disc o_x_axis = of_complex ` {z. Im z < 0}"
proof-
{
fix z
assume "z ∈ disc o_x_axis"
hence "∃ x. Im x < 0 ∧ z = of_complex x"
using inf_or_of_complex[of z]
by auto
}
thus ?thesis
by (auto simp add: image_iff)
qed
subsubsection ‹Oriented single point circline›
lift_definition o_circline_point_0 :: "ocircline" is circline_point_0_clmat
done
lemma of_ocircline_o_circline_point_0 [simp]:
shows "of_ocircline o_circline_point_0 = circline_point_0"
by (transfer, transfer, simp)
subsection ‹Möbius action on oriented circlines and discs›
text ‹Möbius action on an oriented circline is the same as on to an unoriented circline.›
lift_definition moebius_ocircline :: "moebius ⇒ ocircline ⇒ ocircline" is moebius_circline_mmat_clmat
apply (transfer, transfer)
apply simp
apply ((erule exE)+, (erule conjE)+)
apply (simp add: mat_inv_mult_sm)
apply (rule_tac x="ka / Re (k * cnj k)" in exI, auto simp add: complex_mult_cnj_cmod power2_eq_square)
done
text ‹Möbius action on (unoriented) circlines could have been defined using the action on oriented
circlines, but not the other way around.›
lemma moebius_circline_ocircline:
shows "moebius_circline M H = of_ocircline (moebius_ocircline M (of_circline H))"
apply (transfer, simp add: of_circline_clmat_def', safe)
apply (transfer, simp, rule_tac x="-1" in exI, simp)
done
lemma moebius_ocircline_circline:
shows "moebius_ocircline M H = of_circline (moebius_circline M (of_ocircline H)) ∨
moebius_ocircline M H = opposite_ocircline (of_circline (moebius_circline M (of_ocircline H)))"
apply (transfer, simp add: of_circline_clmat_def', safe)
apply (transfer, simp, rule_tac x="1" in exI, simp)
apply (transfer, simp, erule_tac x="1" in allE, simp)
done
text ‹Möbius action on oriented circlines have many nice properties as it was the case with
Möbius action on (unoriented) circlines. These transformations are injective and form group under
composition.›
lemma inj_moebius_ocircline [simp]:
shows "inj (moebius_ocircline M)"
unfolding inj_on_def
proof (safe)
fix H H'
assume "moebius_ocircline M H = moebius_ocircline M H'"
thus "H = H'"
proof (transfer, transfer)
fix M H H' :: complex_mat
assume "mat_det M ≠ 0"
let ?iM = "mat_inv M"
assume "ocircline_eq_cmat (moebius_circline_cmat_cmat M H) (moebius_circline_cmat_cmat M H')"
then obtain k where "congruence ?iM H' = congruence ?iM (cor k *⇩s⇩m H)" "k > 0"
by (auto simp del: congruence_def)
thus "ocircline_eq_cmat H H'"
using ‹mat_det M ≠ 0› inj_congruence[of ?iM H' "cor k *⇩s⇩m H"] mat_det_inv[of M]
by auto
qed
qed
lemma moebius_ocircline_id_moebius [simp]:
shows "moebius_ocircline id_moebius H = H"
by (transfer, transfer) (force simp add: mat_adj_def mat_cnj_def)
lemma moebius_ocircline_comp [simp]:
shows "moebius_ocircline (moebius_comp M1 M2) H = moebius_ocircline M1 (moebius_ocircline M2 H)"
by (transfer, transfer, simp, rule_tac x=1 in exI, simp add: mat_inv_mult_mm mult_mm_assoc)
lemma moebius_ocircline_comp_inv_left [simp]:
shows "moebius_ocircline (moebius_inv M) (moebius_ocircline M H) = H"
by (subst moebius_ocircline_comp[symmetric]) simp
lemma moebius_ocircline_comp_inv_right [simp]:
shows "moebius_ocircline M (moebius_ocircline (moebius_inv M) H) = H"
by (subst moebius_ocircline_comp[symmetric]) simp
lemma moebius_ocircline_opposite_ocircline [simp]:
shows "moebius_ocircline M (opposite_ocircline H) = opposite_ocircline (moebius_ocircline M H)"
by (transfer, transfer, simp, rule_tac x=1 in exI, simp)
text ‹Möbius action on oriented circlines preserve the set of points of the circline.›
lemma ocircline_set_moebius_ocircline [simp]:
shows "ocircline_set (moebius_ocircline M H) = moebius_pt M ` ocircline_set H" (is "?lhs = ?rhs")
proof-
have "?rhs = circline_set (moebius_circline M (of_ocircline H))"
by simp
thus ?thesis
using moebius_ocircline_circline[of M H]
by auto
qed
lemma ocircline_set_fix_iff_ocircline_fix:
assumes "ocircline_set H' ≠ {}"
shows "ocircline_set (moebius_ocircline M H) = ocircline_set H' ⟷
moebius_ocircline M H = H' ∨ moebius_ocircline M H = opposite_ocircline H'"
using assms
using inj_ocircline_set[of "moebius_ocircline M H" H']
by (auto simp del: ocircline_set_moebius_ocircline)
lemma disc_moebius_ocircline [simp]:
shows "disc (moebius_ocircline M H) = moebius_pt M ` (disc H)"
proof (safe)
fix z
assume "z ∈ disc H"
thus "moebius_pt M z ∈ disc (moebius_ocircline M H)"
unfolding disc_def
proof (safe)
assume "in_ocircline H z"
thus "in_ocircline (moebius_ocircline M H) (moebius_pt M z)"
proof (transfer, transfer)
fix H M :: complex_mat and z :: complex_vec
assume "mat_det M ≠ 0"
assume "in_ocircline_cmat_cvec H z"
thus "in_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)"
using ‹mat_det M ≠ 0› quad_form_congruence[of M z]
by simp
qed
qed
next
fix z
assume "z ∈ disc (moebius_ocircline M H)"
thus "z ∈ moebius_pt M ` disc H"
unfolding disc_def
proof(safe)
assume "in_ocircline (moebius_ocircline M H) z"
show "z ∈ moebius_pt M ` Collect (in_ocircline H)"
proof
show "z = moebius_pt M (moebius_pt (moebius_inv M) z)"
by simp
next
show "moebius_pt (moebius_inv M) z ∈ Collect (in_ocircline H)"
using ‹in_ocircline (moebius_ocircline M H) z›
proof (safe, transfer, transfer)
fix M H :: complex_mat and z :: complex_vec
assume "mat_det M ≠ 0"
hence "congruence (mat_inv (mat_inv M)) (congruence (mat_inv M) H) = H"
by (simp del: congruence_def)
hence "quad_form z (congruence (mat_inv M) H) = quad_form (mat_inv M *⇩m⇩v z) H"
using quad_form_congruence[of "mat_inv M" "z" "congruence (mat_inv M) H"]
using ‹mat_det M ≠ 0› mat_det_inv[of "M"]
by simp
moreover
assume "in_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) z"
ultimately
show "in_ocircline_cmat_cvec H (moebius_pt_cmat_cvec (moebius_inv_cmat M) z)"
by simp
qed
qed
qed
qed
lemma disc_compl_moebius_ocircline [simp]:
shows "disc_compl (moebius_ocircline M H) = moebius_pt M ` (disc_compl H)"
proof (safe)
fix z
assume "z ∈ disc_compl H"
thus "moebius_pt M z ∈ disc_compl (moebius_ocircline M H)"
unfolding disc_compl_def
proof (safe)
assume "out_ocircline H z"
thus "out_ocircline (moebius_ocircline M H) (moebius_pt M z)"
proof (transfer, transfer)
fix H M :: complex_mat and z :: complex_vec
assume "mat_det M ≠ 0"
assume "out_ocircline_cmat_cvec H z"
thus "out_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) (moebius_pt_cmat_cvec M z)"
using ‹mat_det M ≠ 0› quad_form_congruence[of M z]
by simp
qed
qed
next
fix z
assume "z ∈ disc_compl (moebius_ocircline M H)"
thus "z ∈ moebius_pt M ` disc_compl H"
unfolding disc_compl_def
proof(safe)
assume "out_ocircline (moebius_ocircline M H) z"
show "z ∈ moebius_pt M ` Collect (out_ocircline H)"
proof
show "z = moebius_pt M (moebius_pt (moebius_inv M) z)"
by simp
next
show "moebius_pt (moebius_inv M) z ∈ Collect (out_ocircline H)"
using ‹out_ocircline (moebius_ocircline M H) z›
proof (safe, transfer, transfer)
fix M H :: complex_mat and z :: complex_vec
assume "mat_det M ≠ 0"
hence "congruence (mat_inv (mat_inv M)) (congruence (mat_inv M) H) = H"
by (simp del: congruence_def)
hence "quad_form z (congruence (mat_inv M) H) = quad_form (mat_inv M *⇩m⇩v z) H"
using quad_form_congruence[of "mat_inv M" "z" "congruence (mat_inv M) H"]
using ‹mat_det M ≠ 0› mat_det_inv[of "M"]
by simp
moreover
assume "out_ocircline_cmat_cvec (moebius_circline_cmat_cmat M H) z"
ultimately
show "out_ocircline_cmat_cvec H (moebius_pt_cmat_cvec (moebius_inv_cmat M) z)"
by simp
qed
qed
qed
qed
subsection ‹Orientation after Möbius transformations›
text ‹All Euclidean similarities preserve circline orientation.›
lemma moebius_similarity_oriented_lines_to_oriented_lines:
assumes "a ≠ 0"
shows "∞⇩h ∈ ocircline_set H ⟷ ∞⇩h ∈ ocircline_set (moebius_ocircline (moebius_similarity a b) H)"
using moebius_similarity_lines_to_lines[OF ‹a ≠ 0›, of b "of_ocircline H"]
by simp
lemma moebius_similarity_preserve_orientation':
assumes "a ≠ 0" and "∞⇩h ∉ ocircline_set H" and "pos_oriented H"
shows "pos_oriented (moebius_ocircline (moebius_similarity a b) H)"
proof-
let ?M = "moebius_similarity a b"
let ?H = "moebius_ocircline ?M H"
have "∞⇩h ∉ ocircline_set ?H"
using ‹∞⇩h ∉ ocircline_set H› moebius_similarity_oriented_lines_to_oriented_lines[OF ‹a ≠ 0›]
by simp
have "∞⇩h ∈ disc_compl H"
using ‹∞⇩h ∉ ocircline_set H› ‹pos_oriented H› pos_oriented_circle_inf[of H] in_on_out
unfolding disc_def disc_compl_def ocircline_set_def
by auto
hence "∞⇩h ∈ disc_compl ?H"
using moebius_similarity_inf[OF ‹a ≠ 0›, of b]
by force
thus "pos_oriented ?H"
using pos_oriented_circle_inf[of ?H] disc_inter_disc_compl[of ?H] ‹∞⇩h ∉ ocircline_set ?H›
by auto
qed
lemma moebius_similarity_preserve_orientation:
assumes "a ≠ 0" and "∞⇩h ∉ ocircline_set H"
shows "pos_oriented H ⟷ pos_oriented(moebius_ocircline (moebius_similarity a b) H)"
proof-
let ?M = "moebius_similarity a b"
let ?H = "moebius_ocircline ?M H"
have "∞⇩h ∉ ocircline_set ?H"
using ‹∞⇩h ∉ ocircline_set H› moebius_similarity_oriented_lines_to_oriented_lines[OF ‹a ≠ 0›]
by simp
have *: "H = moebius_ocircline (- moebius_similarity a b) ?H"
by simp
show ?thesis
using ‹a ≠ 0›
using moebius_similarity_preserve_orientation' [OF ‹a ≠ 0› ‹∞⇩h ∉ ocircline_set H›]
using moebius_similarity_preserve_orientation'[OF _ ‹∞⇩h ∉ ocircline_set ?H›, of "1/a" "-b/a"]
using moebius_similarity_inv[of a b, OF ‹a ≠ 0›] *
by auto
qed
lemma reciprocal_preserve_orientation:
assumes "0⇩h ∈ disc_compl H"
shows "pos_oriented (moebius_ocircline moebius_reciprocal H)"
proof-
have "∞⇩h ∈ disc_compl (moebius_ocircline moebius_reciprocal H)"
using assms
by force
thus "pos_oriented (moebius_ocircline moebius_reciprocal H)"
using pos_oriented_circle_inf[of "moebius_ocircline moebius_reciprocal H"]
using disc_inter_disc_compl[of "moebius_ocircline moebius_reciprocal H"]
using disc_compl_inter_ocircline_set[of "moebius_ocircline moebius_reciprocal H"]
by auto
qed
lemma reciprocal_not_preserve_orientation:
assumes "0⇩h ∈ disc H"
shows "¬ pos_oriented (moebius_ocircline moebius_reciprocal H)"
proof-
let ?H = "moebius_ocircline moebius_reciprocal H"
have "∞⇩h ∈ disc ?H"
using assms
by force
thus "¬ pos_oriented ?H"
using pos_oriented_circle_inf[of ?H] disc_inter_ocircline_set[of ?H]
by auto
qed
text ‹Orientation of the image of a given oriented circline $H$ under a given Möbius transformation
$M$ depends on whether the pole of $M$ (the point that $M$ maps to $\infty_{hc}$) lies in the disc
or in the disc complement of $H$ (if it is on the set of $H$, then it maps onto a line and we do not
discuss the orientation).›
lemma pole_in_disc:
assumes "M = mk_moebius a b c d" and "c ≠ 0" and "a*d - b*c ≠ 0"
assumes "is_pole M z" "z ∈ disc H"
shows "¬ pos_oriented (moebius_ocircline M H)"
proof-
let ?t1 = "moebius_translation (a / c)"
let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))"
let ?r = "moebius_reciprocal"
let ?t2 = "moebius_translation (d / c)"
have "0⇩h = moebius_pt (moebius_translation (d/c)) z"
using pole_mk_moebius[of a b c d z] assms
by simp
have "z ∉ ocircline_set H"
using ‹z ∈ disc H› disc_inter_ocircline_set[of H]
by blast
hence "0⇩h ∉ ocircline_set (moebius_ocircline ?t2 H)"
using ‹0⇩h = moebius_pt ?t2 z›
using moebius_pt_neq_I[of z _ ?t2]
by force
hence *: "∞⇩h ∉ ocircline_set (moebius_ocircline (?r + ?t2) H)"
using ‹0⇩h = moebius_pt (moebius_translation (d / c)) z›
by (metis circline_set_moebius_circline circline_set_moebius_circline_iff circline_set_of_ocircline moebius_pt_comp moebius_reciprocal ocircline_set_moebius_ocircline plus_moebius_def reciprocal_zero)
hence **: "∞⇩h ∉ ocircline_set (moebius_ocircline (?rd + ?r + ?t2) H)"
using ‹a*d - b*c ≠ 0› ‹c ≠ 0›
unfolding moebius_rotation_dilatation_def
using moebius_similarity_oriented_lines_to_oriented_lines[of _ "moebius_ocircline (?r + ?t2) H"]
by (metis divide_eq_0_iff divisors_zero moebius_ocircline_comp plus_moebius_def right_minus_eq)
have "¬ pos_oriented (moebius_ocircline (?r + ?t2) H)"
using pole_mk_moebius[of a b c d z] assms
using reciprocal_not_preserve_orientation
by force
hence "¬ pos_oriented (moebius_ocircline (?rd + ?r + ?t2) H)"
using *
using ‹a*d - b*c ≠ 0› ‹c ≠ 0›
using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?r + ?t2) H"]
unfolding moebius_rotation_dilatation_def
by simp
hence "¬ pos_oriented (moebius_ocircline (?t1 + ?rd + ?r + ?t2) H)"
using **
using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?rd + ?r + ?t2) H"]
unfolding moebius_translation_def
by simp
thus ?thesis
using assms
by simp (subst moebius_decomposition, simp_all)
qed
lemma pole_in_disc_compl:
assumes "M = mk_moebius a b c d" and "c ≠ 0" and "a*d - b*c ≠ 0"
assumes "is_pole M z" and "z ∈ disc_compl H"
shows "pos_oriented (moebius_ocircline M H)"
proof-
let ?t1 = "moebius_translation (a / c)"
let ?rd = "moebius_rotation_dilatation ((b * c - a * d) / (c * c))"
let ?r = "moebius_reciprocal"
let ?t2 = "moebius_translation (d / c)"
have "0⇩h = moebius_pt (moebius_translation (d/c)) z"
using pole_mk_moebius[of a b c d z] assms
by simp
have "z ∉ ocircline_set H"
using ‹z ∈ disc_compl H› disc_compl_inter_ocircline_set[of H]
by blast
hence "0⇩h ∉ ocircline_set (moebius_ocircline ?t2 H)"
using ‹0⇩h = moebius_pt ?t2 z›
using moebius_pt_neq_I[of z _ ?t2]
by force
hence *: "∞⇩h ∉ ocircline_set (moebius_ocircline (?r + ?t2) H)"
using ‹0⇩h = moebius_pt (moebius_translation (d / c)) z›
by (metis circline_set_moebius_circline circline_set_moebius_circline_iff circline_set_of_ocircline moebius_pt_comp moebius_reciprocal ocircline_set_moebius_ocircline plus_moebius_def reciprocal_zero)
hence **: "∞⇩h ∉ ocircline_set (moebius_ocircline (?rd + ?r + ?t2) H)"
using ‹a*d - b*c ≠ 0› ‹c ≠ 0›
unfolding moebius_rotation_dilatation_def
using moebius_similarity_oriented_lines_to_oriented_lines[of _ "moebius_ocircline (?r + ?t2) H"]
by (metis divide_eq_0_iff divisors_zero moebius_ocircline_comp plus_moebius_def right_minus_eq)
have "pos_oriented (moebius_ocircline (?r + ?t2) H)"
using pole_mk_moebius[of a b c d z] assms
using reciprocal_preserve_orientation
by force
hence "pos_oriented (moebius_ocircline (?rd + ?r + ?t2) H)"
using *
using ‹a*d - b*c ≠ 0› ‹c ≠ 0›
using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?r + ?t2) H"]
unfolding moebius_rotation_dilatation_def
by simp
hence "pos_oriented (moebius_ocircline (?t1 + ?rd + ?r + ?t2) H)"
using **
using moebius_similarity_preserve_orientation[of _ "moebius_ocircline (?rd + ?r + ?t2) H"]
unfolding moebius_translation_def
by simp
thus ?thesis
using assms
by simp (subst moebius_decomposition, simp_all)
qed
subsection ‹Oriented circlines uniqueness›
lemma ocircline_01inf:
assumes "0⇩h ∈ ocircline_set H ∧ 1⇩h ∈ ocircline_set H ∧ ∞⇩h ∈ ocircline_set H"
shows "H = o_x_axis ∨ H = opposite_ocircline o_x_axis"
proof-
have "0⇩h ∈ circline_set (of_ocircline H) ∧ 1⇩h ∈ circline_set (of_ocircline H) ∧ ∞⇩h ∈ circline_set (of_ocircline H)"
using assms
by simp
hence "of_ocircline H = x_axis"
using unique_circline_01inf'
by auto
thus "H = o_x_axis ∨ H = opposite_ocircline o_x_axis"
by (metis inj_of_ocircline of_ocircline_o_x_axis)
qed
lemma unique_ocircline_01inf:
shows "∃! H. 0⇩h ∈ ocircline_set H ∧ 1⇩h ∈ ocircline_set H ∧ ∞⇩h ∈ ocircline_set H ∧ ii⇩h ∉ disc H"
proof
show "0⇩h ∈ ocircline_set o_x_axis ∧ 1⇩h ∈ ocircline_set o_x_axis ∧ ∞⇩h ∈ ocircline_set o_x_axis ∧ ii⇩h ∉ disc o_x_axis"
by simp
next
fix H
assume "0⇩h ∈ ocircline_set H ∧ 1⇩h ∈ ocircline_set H ∧ ∞⇩h ∈ ocircline_set H ∧ ii⇩h ∉ disc H"
hence "0⇩h ∈ ocircline_set H ∧ 1⇩h ∈ ocircline_set H ∧ ∞⇩h ∈ ocircline_set H" "ii⇩h ∉ disc H"
by auto
hence "H = o_x_axis ∨ H = opposite_ocircline o_x_axis"
using ocircline_01inf
by simp
thus "H = o_x_axis"
using ‹ii⇩h ∉ disc H›
by auto
qed
lemma unique_ocircline_set:
assumes "A ≠ B" and "A ≠ C" and "B ≠ C"
shows "∃! H. pos_oriented H ∧ (A ∈ ocircline_set H ∧ B ∈ ocircline_set H ∧ C ∈ ocircline_set H)"
proof-
obtain M where *: "moebius_pt M A = 0⇩h" "moebius_pt M B = 1⇩h" "moebius_pt M C = ∞⇩h"
using ex_moebius_01inf[OF assms]
by auto
let ?iM = "moebius_pt (moebius_inv M)"
have **: "?iM 0⇩h = A" "?iM 1⇩h = B" "?iM ∞⇩h = C"
using *
by (auto simp add: moebius_pt_invert)
let ?H = "moebius_ocircline (moebius_inv M) o_x_axis"
have 1: "A ∈ ocircline_set ?H" "B ∈ ocircline_set ?H" "C ∈ ocircline_set ?H"
using **
by auto
have 2: "⋀ H'. A ∈ ocircline_set H' ∧ B ∈ ocircline_set H' ∧ C ∈ ocircline_set H' ⟹ H' = ?H ∨ H' = opposite_ocircline ?H"
proof-
fix H'
let ?H' = "ocircline_set H'" and ?H'' = "ocircline_set (moebius_ocircline M H')"
assume "A ∈ ocircline_set H' ∧ B ∈ ocircline_set H' ∧ C ∈ ocircline_set H'"
hence "moebius_pt M A ∈ ?H''" "moebius_pt M B ∈ ?H''" "moebius_pt M C ∈ ?H''"
by auto
hence "0⇩h ∈ ?H''" "1⇩h ∈ ?H''" "∞⇩h ∈ ?H''"
using *
by auto
hence "moebius_ocircline M H' = o_x_axis ∨ moebius_ocircline M H' = opposite_ocircline o_x_axis"
using ocircline_01inf
by auto
hence "o_x_axis = moebius_ocircline M H' ∨ o_x_axis = opposite_ocircline (moebius_ocircline M H')"
by auto
thus "H' = ?H ∨ H' = opposite_ocircline ?H"
proof
assume *: "o_x_axis = moebius_ocircline M H'"
show "H' = moebius_ocircline (moebius_inv M) o_x_axis ∨ H' = opposite_ocircline (moebius_ocircline (moebius_inv M) o_x_axis)"
by (rule disjI1) (subst *, simp)
next
assume *: "o_x_axis = opposite_ocircline (moebius_ocircline M H')"
show "H' = moebius_ocircline (moebius_inv M) o_x_axis ∨ H' = opposite_ocircline (moebius_ocircline (moebius_inv M) o_x_axis)"
by (rule disjI2) (subst *, simp)
qed
qed
show ?thesis (is "∃! x. ?P x")
proof (cases "pos_oriented ?H")
case True
show ?thesis
proof
show "?P ?H"
using 1 True
by auto
next
fix H
assume "?P H"
thus "H = ?H"
using 1 2[of H] True
by auto
qed
next
case False
let ?OH = "opposite_ocircline ?H"
show ?thesis
proof
show "?P ?OH"
using 1 False
by auto
next
fix H
assume "?P H"
thus "H = ?OH"
using False 2[of H]
by auto
qed
qed
qed
lemma ocircline_set_0h:
assumes "ocircline_set H = {0⇩h}"
shows "H = o_circline_point_0 ∨ H = opposite_ocircline (o_circline_point_0)"
proof-
have "of_ocircline H = circline_point_0"
using assms
using unique_circline_type_zero_0' card_eq1_circline_type_zero[of "of_ocircline H"]
by auto
thus ?thesis
by (metis inj_of_ocircline of_ocircline_o_circline_point_0)
qed
end
Theory Circlines_Angle
theory Circlines_Angle
imports Oriented_Circlines Elementary_Complex_Geometry
begin
subsection ‹Angle between circlines›
text ‹Angle between circlines can be defined in purely algebraic terms (following Schwerdtfeger
\cite{schwerdtfeger}) and using this definitions many properties can be easily proved.›
fun mat_det_12 :: "complex_mat ⇒ complex_mat ⇒ complex" where
"mat_det_12 (A1, B1, C1, D1) (A2, B2, C2, D2) = A1*D2 + A2*D1 - B1*C2 - B2*C1"
lemma mat_det_12_mm_l [simp]:
shows "mat_det_12 (M *⇩m⇩m A) (M *⇩m⇩m B) = mat_det M * mat_det_12 A B"
by (cases M, cases A, cases B) (simp add: field_simps)
lemma mat_det_12_mm_r [simp]:
shows "mat_det_12 (A *⇩m⇩m M) (B *⇩m⇩m M) = mat_det M * mat_det_12 A B"
by (cases M, cases A, cases B) (simp add: field_simps)
lemma mat_det_12_sm_l [simp]:
shows "mat_det_12 (k *⇩s⇩m A) B = k * mat_det_12 A B"
by (cases A, cases B) (simp add: field_simps)
lemma mat_det_12_sm_r [simp]:
shows "mat_det_12 A (k *⇩s⇩m B) = k * mat_det_12 A B"
by (cases A, cases B) (simp add: field_simps)
lemma mat_det_12_congruence [simp]:
shows "mat_det_12 (congruence M A) (congruence M B) = (cor ((cmod (mat_det M))⇧2)) * mat_det_12 A B"
unfolding congruence_def
by ((subst mult_mm_assoc[symmetric])+, subst mat_det_12_mm_l, subst mat_det_12_mm_r, subst mat_det_adj) (auto simp add: field_simps complex_mult_cnj_cmod)
definition cos_angle_cmat :: "complex_mat ⇒ complex_mat ⇒ real" where
[simp]: "cos_angle_cmat H1 H2 = - Re (mat_det_12 H1 H2) / (2 * (sqrt (Re (mat_det H1 * mat_det H2))))"
lift_definition cos_angle_clmat :: "circline_mat ⇒ circline_mat ⇒ real" is cos_angle_cmat
done
lemma cos_angle_den_scale [simp]:
assumes "k1 > 0" and "k2 > 0"
shows "sqrt (Re ((k1⇧2 * mat_det H1) * (k2⇧2 * mat_det H2))) =
k1 * k2 * sqrt (Re (mat_det H1 * mat_det H2))"
proof-
let ?lhs = "(k1⇧2 * mat_det H1) * (k2⇧2 * mat_det H2)"
let ?rhs = "mat_det H1 * mat_det H2"
have 1: "?lhs = (k1⇧2*k2⇧2) * ?rhs"
by simp
hence "Re ?lhs = (k1⇧2*k2⇧2) * Re ?rhs"
by (simp add: field_simps)
thus ?thesis
using assms
by (simp add: real_sqrt_mult)
qed
lift_definition cos_angle :: "ocircline ⇒ ocircline ⇒ real" is cos_angle_clmat
proof transfer
fix H1 H2 H1' H2'
assume "ocircline_eq_cmat H1 H1'" "ocircline_eq_cmat H2 H2'"
then obtain k1 k2 :: real where
*: "k1 > 0" "H1' = cor k1 *⇩s⇩m H1"
"k2 > 0" "H2' = cor k2 *⇩s⇩m H2"
by auto
thus "cos_angle_cmat H1 H2 = cos_angle_cmat H1' H2'"
unfolding cos_angle_cmat_def
apply (subst *)+
apply (subst mat_det_12_sm_l, subst mat_det_12_sm_r)
apply (subst mat_det_mult_sm)+
apply (subst power2_eq_square[symmetric])+
apply (subst cos_angle_den_scale, simp, simp)
apply simp
done
qed
text ‹Möbius transformations are conformal, meaning that they preserve oriented angle between
oriented circlines.›
lemma cos_angle_opposite1 [simp]:
shows "cos_angle (opposite_ocircline H) H' = - cos_angle H H'"
by (transfer, transfer, simp)
lemma cos_angle_opposite2 [simp]:
shows "cos_angle H (opposite_ocircline H') = - cos_angle H H'"
by (transfer, transfer, simp)
subsubsection ‹Connection with the elementary angle definition between circles›
text‹We want to connect algebraic definition of an angle with a traditional one and
to prove equivalency between these two definitions. For the traditional definition of
an angle we follow the approach suggested by Needham \cite{needham}.›
lemma Re_sgn:
assumes "is_real A" and "A ≠ 0"
shows "Re (sgn A) = sgn_bool (Re A > 0)"
using assms
using More_Complex.Re_sgn complex_eq_if_Re_eq
by auto
lemma Re_mult_real3:
assumes "is_real z1" and "is_real z2" and "is_real z3"
shows "Re (z1 * z2 * z3) = Re z1 * Re z2 * Re z3"
using assms
by (metis Re_mult_real mult_reals)
lemma sgn_sqrt [simp]:
shows "sgn (sqrt x) = sgn x"
by (simp add: sgn_root sqrt_def)
lemma real_circle_sgn_r:
assumes "is_circle H" and "(a, r) = euclidean_circle H"
shows "sgn r = - circline_type H"
using assms
proof (transfer, transfer)
fix H :: complex_mat and a r
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases H) auto
hence "is_real A" "is_real D"
using hermitean_elems hh
by auto
assume "¬ circline_A0_cmat H" "(a, r) = euclidean_circle_cmat H"
hence "A ≠ 0"
using ‹¬ circline_A0_cmat H› HH
by simp
hence "Re A * Re A > 0"
using ‹is_real A›
using complex_eq_if_Re_eq not_real_square_gt_zero
by fastforce
thus "sgn r = - circline_type_cmat H"
using HH ‹(a, r) = euclidean_circle_cmat H› ‹is_real A› ‹is_real D› ‹A ≠ 0›
by (simp add: Re_divide_real sgn_minus[symmetric])
qed
text ‹The definition of an angle using algebraic terms is not intuitive, and we want to connect it to
the more common definition given earlier that defines an
angle between circlines as the angle between tangent vectors in the point of the intersection of the
circlines.›
lemma cos_angle_eq_cos_ang_circ:
assumes
"is_circle (of_ocircline H1)" and "is_circle (of_ocircline H2)" and
"circline_type (of_ocircline H1) < 0" and "circline_type (of_ocircline H2) < 0"
"(a1, r1) = euclidean_circle (of_ocircline H1)" and "(a2, r2) = euclidean_circle (of_ocircline H2)" and
"of_complex E ∈ ocircline_set H1 ∩ ocircline_set H2"
shows "cos_angle H1 H2 = cos (ang_circ E a1 a2 (pos_oriented H1) (pos_oriented H2))"
proof-
let ?p1 = "pos_oriented H1" and ?p2 = "pos_oriented H2"
have "E ∈ circle a1 r1" "E ∈ circle a2 r2"
using classic_circle[of "of_ocircline H1" a1 r1] classic_circle[of "of_ocircline H2" a2 r2]
using assms of_complex_inj
by auto
hence *: "cdist E a1 = r1" "cdist E a2 = r2"
unfolding circle_def
by (simp_all add: norm_minus_commute)
have "r1 > 0" "r2 > 0"
using assms(1-6) real_circle_sgn_r[of "of_ocircline H1" a1 r1] real_circle_sgn_r[of "of_ocircline H2" a2 r2]
using sgn_greater
by fastforce+
hence "E ≠ a1" "E ≠ a2"
using ‹cdist E a1 = r1› ‹cdist E a2 = r2›
by auto
let ?k = "sgn_bool (?p1 = ?p2)"
let ?xx = "?k * (r1⇧2 + r2⇧2 - (cdist a2 a1)⇧2) / (2 * r1 * r2)"
have "cos (ang_circ E a1 a2 ?p1 ?p2) = ?xx"
using law_of_cosines[of a2 a1 E] * ‹r1 > 0› ‹r2 > 0› cos_ang_circ_simp[OF ‹E ≠ a1› ‹E ≠ a2›]
by (subst (asm) ang_vec_opposite_opposite'[OF ‹E ≠ a1›[symmetric] ‹E ≠ a2›[symmetric], symmetric]) simp
moreover
have "cos_angle H1 H2 = ?xx"
using ‹r1 > 0› ‹r2 > 0›
using ‹(a1, r1) = euclidean_circle (of_ocircline H1)› ‹(a2, r2) = euclidean_circle (of_ocircline H2)›
using ‹is_circle (of_ocircline H1)› ‹is_circle (of_ocircline H2)›
using ‹circline_type (of_ocircline H1) < 0› ‹circline_type (of_ocircline H2) < 0›
proof (transfer, transfer)
fix a1 r1 H1 H2 a2 r2
assume hh: "hermitean H1 ∧ H1 ≠ mat_zero" "hermitean H2 ∧ H2 ≠ mat_zero"
obtain A1 B1 C1 D1 where HH1: "H1 = (A1, B1, C1, D1)"
by (cases H1) auto
obtain A2 B2 C2 D2 where HH2: "H2 = (A2, B2, C2, D2)"
by (cases H2) auto
have *: "is_real A1" "is_real A2" "is_real D1" "is_real D2" "cnj B1 = C1" "cnj B2 = C2"
using hh hermitean_elems[of A1 B1 C1 D1] hermitean_elems[of A2 B2 C2 D2] HH1 HH2
by auto
have "cnj A1 = A1" "cnj A2 = A2"
using ‹is_real A1› ‹is_real A2›
by (case_tac[!] A1, case_tac[!] A2, auto simp add: Complex_eq)
assume "¬ circline_A0_cmat (id H1)" "¬ circline_A0_cmat (id H2)"
hence "A1 ≠ 0" "A2 ≠ 0"
using HH1 HH2
by auto
hence "Re A1 ≠ 0" "Re A2 ≠ 0"
using ‹is_real A1› ‹is_real A2›
using complex.expand
by auto
assume "circline_type_cmat (id H1) < 0" "circline_type_cmat (id H2) < 0"
assume "(a1, r1) = euclidean_circle_cmat (id H1)" "(a2, r2) = euclidean_circle_cmat (id H2)"
assume "r1 > 0" "r2 > 0"
let ?D12 = "mat_det_12 H1 H2" and ?D1 = "mat_det H1" and ?D2 = "mat_det H2"
let ?x1 = "(cdist a2 a1)⇧2 - r1⇧2 - r2⇧2" and ?x2 = "2*r1*r2"
let ?x = "?x1 / ?x2"
have *: "Re (?D12) / (2 * (sqrt (Re (?D1 * ?D2)))) = Re (sgn A1) * Re (sgn A2) * ?x"
proof-
let ?M1 = "(A1, B1, C1, D1)" and ?M2 = "(A2, B2, C2, D2)"
let ?d1 = "B1 * C1 - A1 * D1" and ?d2 = "B2 * C2 - A2 * D2"
have "Re ?d1 > 0" "Re ?d2 > 0"
using HH1 HH2 ‹circline_type_cmat (id H1) < 0› ‹circline_type_cmat (id H2) < 0›
by auto
hence **: "Re (?d1 / (A1 * A1)) > 0" "Re (?d2 / (A2 * A2)) > 0"
using ‹is_real A1› ‹is_real A2› ‹A1 ≠ 0› ‹A2 ≠ 0›
by (subst Re_divide_real, simp_all add: complex_neq_0 power2_eq_square)+
have ***: "is_real (?d1 / (A1 * A1)) ∧ is_real (?d2 / (A2 * A2))"
using ‹is_real A1› ‹is_real A2› ‹A1 ≠ 0› ‹A2 ≠ 0› ‹cnj B1 = C1›[symmetric] ‹cnj B2 = C2›[symmetric] ‹is_real D1› ‹is_real D2›
by (subst div_reals, simp, simp, simp)+
have "cor ?x = mat_det_12 ?M1 ?M2 / (2 * sgn A1 * sgn A2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))"
proof-
have "A1*A2*cor ?x1 = mat_det_12 ?M1 ?M2"
proof-
have 1: "A1*A2*(cor ((cdist a2 a1)⇧2)) = ((B2*A1 - A2*B1)*(C2*A1 - C1*A2)) / (A1*A2)"
using ‹(a1, r1) = euclidean_circle_cmat (id H1)› ‹(a2, r2) = euclidean_circle_cmat (id H2)›
unfolding cdist_def cmod_square
using HH1 HH2 * ‹A1 ≠ 0› ‹A2 ≠ 0› ‹cnj A1 = A1› ‹cnj A2 = A2›
unfolding Let_def
apply (subst complex_of_real_Re)
apply (simp add: field_simps)
apply (simp add: complex_mult_cnj_cmod power2_eq_square)
apply (simp add: field_simps)
done
have 2: "A1*A2*cor (-r1⇧2) = A2*D1 - B1*C1*A2/A1"
using ‹(a1, r1) = euclidean_circle_cmat (id H1)›
using HH1 ** * *** ‹A1 ≠ 0›
by (simp add: power2_eq_square field_simps)
have 3: "A1*A2*cor (-r2⇧2) = A1*D2 - B2*C2*A1/A2"
using ‹(a2, r2) = euclidean_circle_cmat (id H2)›
using HH2 ** * *** ‹A2 ≠ 0›
by (simp add: power2_eq_square field_simps)
have "A1*A2*cor((cdist a2 a1)⇧2) + A1*A2*cor(-r1⇧2) + A1*A2*cor(-r2⇧2) = mat_det_12 ?M1 ?M2"
using ‹A1 ≠ 0› ‹A2 ≠ 0›
by (subst 1, subst 2, subst 3) (simp add: field_simps)
thus ?thesis
by (simp add: field_simps)
qed
moreover
have "A1 * A2 * cor (?x2) = 2 * sgn A1 * sgn A2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2))"
proof-
have 1: "sqrt (Re (?d1/ (A1 * A1))) = sqrt (Re ?d1) / ¦Re A1¦"
using ‹A1 ≠ 0› ‹is_real A1›
by (subst Re_divide_real, simp, simp, subst real_sqrt_divide, simp)
have 2: "sqrt (Re (?d2/ (A2 * A2))) = sqrt (Re ?d2) / ¦Re A2¦"
using ‹A2 ≠ 0› ‹is_real A2›
by (subst Re_divide_real, simp, simp, subst real_sqrt_divide, simp)
have "sgn A1 = A1 / cor ¦Re A1¦"
using ‹is_real A1›
unfolding sgn_eq
by (simp add: cmod_eq_Re)
moreover
have "sgn A2 = A2 / cor ¦Re A2¦"
using ‹is_real A2›
unfolding sgn_eq
by (simp add: cmod_eq_Re)
ultimately
show ?thesis
using ‹(a1, r1) = euclidean_circle_cmat (id H1)› ‹(a2, r2) = euclidean_circle_cmat (id H2)› HH1 HH2
using *** ‹is_real A1› ‹is_real A2›
by simp (subst 1, subst 2, simp)
qed
ultimately
have "(A1 * A2 * cor ?x1) / (A1 * A2 * (cor ?x2)) =
mat_det_12 ?M1 ?M2 / (2 * sgn A1 * sgn A2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))"
by simp
thus ?thesis
using ‹A1 ≠ 0› ‹A2 ≠ 0›
by simp
qed
hence "cor ?x * sgn A1 * sgn A2 = mat_det_12 ?M1 ?M2 / (2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))"
using ‹A1 ≠ 0› ‹A2 ≠ 0›
by (simp add: sgn_zero_iff)
moreover
have "Re (cor ?x * sgn A1 * sgn A2) = Re (sgn A1) * Re (sgn A2) * ?x"
proof-
have "is_real (cor ?x)" "is_real (sgn A1)" "is_real (sgn A2)"
using ‹is_real A1› ‹is_real A2› Im_complex_of_real[of ?x]
by auto
thus ?thesis
using Re_complex_of_real[of ?x]
by (subst Re_mult_real3, auto simp add: field_simps)
qed
moreover
have *: "sqrt (Re ?D1) * sqrt (Re ?D2) = sqrt (Re ?d1) * sqrt (Re ?d2)"
using HH1 HH2
by (subst real_sqrt_mult[symmetric])+ (simp add: field_simps)
have "2 * (sqrt (Re (?D1 * ?D2))) ≠ 0"
using ‹Re ?d1 > 0› ‹Re ?d2 > 0› HH1 HH2 ‹is_real A1› ‹is_real A2› ‹is_real D1› ‹is_real D2›
using hh mat_det_hermitean_real[of "H1"]
by (subst Re_mult_real, auto)
hence **: "Re (?D12 / (2 * cor (sqrt (Re (?D1 * ?D2))))) = Re (?D12) / (2 * (sqrt (Re (?D1 * ?D2))))"
using ‹Re ?d1 > 0› ‹Re ?d2 > 0› HH1 HH2 ‹is_real A1› ‹is_real A2› ‹is_real D1› ‹is_real D2›
by (subst Re_divide_real) auto
have "Re (mat_det_12 ?M1 ?M2 / (2 * cor (sqrt (Re ?d1) * sqrt (Re ?d2)))) = Re (?D12) / (2 * (sqrt (Re (?D1 * ?D2))))"
using HH1 HH2 hh mat_det_hermitean_real[of "H1"]
by (subst **[symmetric], subst Re_mult_real, simp, subst real_sqrt_mult, subst *, simp)
ultimately
show ?thesis
by simp
qed
have **: "pos_oriented_cmat H1 ⟷ Re A1 > 0" "pos_oriented_cmat H2 ⟷ Re A2 > 0"
using ‹Re A1 ≠ 0› HH1 ‹Re A2 ≠ 0› HH2
by auto
show "cos_angle_cmat H1 H2 = sgn_bool (pos_oriented_cmat H1 = pos_oriented_cmat H2) * (r1⇧2 + r2⇧2 - (cdist a2 a1)⇧2) / (2 * r1 * r2)"
unfolding Let_def
using ‹r1 > 0› ‹r2 > 0›
unfolding cos_angle_cmat_def
apply (subst divide_minus_left)
apply (subst *)
apply (subst Re_sgn[OF ‹is_real A1› ‹A1 ≠ 0›], subst Re_sgn[OF ‹is_real A2› ‹A2 ≠ 0›])
apply (subst **, subst **)
apply (simp add: field_simps)
done
qed
ultimately
show ?thesis
by simp
qed
subsection ‹Perpendicularity›
text ‹Two circlines are perpendicular if the intersect at right angle i.e., the angle with the cosine
0.›
definition perpendicular where
"perpendicular H1 H2 ⟷ cos_angle (of_circline H1) (of_circline H2) = 0"
lemma perpendicular_sym:
shows "perpendicular H1 H2 ⟷ perpendicular H2 H1"
unfolding perpendicular_def
by (transfer, transfer, auto simp add: field_simps)
subsection ‹Möbius transforms preserve angles and perpendicularity›
text ‹Möbius transformations are \emph{conformal} i.e., they preserve angles between circlines.›
lemma moebius_preserve_circline_angle [simp]:
shows "cos_angle (moebius_ocircline M H1) (moebius_ocircline M H2) =
cos_angle H1 H2 "
proof (transfer, transfer)
fix H1 H2 M :: complex_mat
assume hh: "mat_det M ≠ 0"
show "cos_angle_cmat (moebius_circline_cmat_cmat M H1) (moebius_circline_cmat_cmat M H2) = cos_angle_cmat H1 H2"
unfolding cos_angle_cmat_def moebius_circline_cmat_cmat_def
unfolding Let_def mat_det_12_congruence mat_det_congruence
using hh mat_det_inv[of M]
apply (subst cor_squared[symmetric])+
apply (subst cos_angle_den_scale, simp)
apply (auto simp add: power2_eq_square real_sqrt_mult field_simps)
done
qed
lemma perpendicular_moebius [simp]:
assumes "perpendicular H1 H2"
shows "perpendicular (moebius_circline M H1) (moebius_circline M H2)"
using assms
unfolding perpendicular_def
using moebius_preserve_circline_angle[of M "of_circline H1" "of_circline H2"]
using moebius_ocircline_circline[of M "of_circline H1"]
using moebius_ocircline_circline[of M "of_circline H2"]
by (auto simp del: moebius_preserve_circline_angle)
end
Theory Unit_Circle_Preserving_Moebius
section ‹Unit circle preserving Möbius transformations›
text ‹In this section we shall examine Möbius transformations that map the unit circle onto itself.
We shall say that they fix or preserve the unit circle (although, they do not need to fix each of
its points).›
theory Unit_Circle_Preserving_Moebius
imports Unitary11_Matrices Moebius Oriented_Circlines
begin
subsection ‹Möbius transformations that fix the unit circle›
text ‹We define Möbius transformations that preserve unit circle as transformations represented by
generalized unitary matrices with the $1-1$ signature (elements of the gruop $GU_{1,1}(2,
\mathbb{C})$, defined earlier in the theory Unitary11Matrices).›
lift_definition unit_circle_fix_mmat :: "moebius_mat ⇒ bool" is unitary11_gen
done
lift_definition unit_circle_fix :: "moebius ⇒ bool" is unit_circle_fix_mmat
apply transfer
apply (auto simp del: mult_sm.simps)
apply (simp del: mult_sm.simps add: unitary11_gen_mult_sm)
apply (simp del: mult_sm.simps add: unitary11_gen_div_sm)
done
text ‹Our algebraic characterisation (by matrices) is geometrically correct.›
lemma unit_circle_fix_iff:
shows "unit_circle_fix M ⟷
moebius_circline M unit_circle = unit_circle" (is "?rhs = ?lhs")
proof
assume ?lhs
thus ?rhs
proof (transfer, transfer)
fix M :: complex_mat
assume "mat_det M ≠ 0"
assume "circline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
then obtain k where "k ≠ 0" "(1, 0, 0, -1) = cor k *⇩s⇩m congruence (mat_inv M) (1, 0, 0, -1)"
by auto
hence "(1/cor k, 0, 0, -1/cor k) = congruence (mat_inv M) (1, 0, 0, -1)"
using mult_sm_inv_l[of "cor k" "congruence (mat_inv M) (1, 0, 0, -1)" ]
by simp
hence "congruence M (1/cor k, 0, 0, -1/cor k) = (1, 0, 0, -1)"
using ‹mat_det M ≠ 0› mat_det_inv[of M]
using congruence_inv[of "mat_inv M" "(1, 0, 0, -1)" "(1/cor k, 0, 0, -1/cor k)"]
by simp
hence "congruence M (1, 0, 0, -1) = cor k *⇩s⇩m (1, 0, 0, -1)"
using congruence_scale_m[of "M" "1/cor k" "(1, 0, 0, -1)"]
using mult_sm_inv_l[of "1/ cor k" "congruence M (1, 0, 0, -1)" "(1, 0, 0, -1)"] ‹k ≠ 0›
by simp
thus "unitary11_gen M"
using ‹k ≠ 0›
unfolding unitary11_gen_def
by simp
qed
next
assume ?rhs
thus ?lhs
proof (transfer, transfer)
fix M :: complex_mat
assume "mat_det M ≠ 0"
assume "unitary11_gen M"
hence "unitary11_gen (mat_inv M)"
using ‹mat_det M ≠ 0›
using unitary11_gen_mat_inv
by simp
thus " circline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
unfolding unitary11_gen_real
by auto (rule_tac x="1/k" in exI, simp)
qed
qed
lemma circline_set_fix_iff_circline_fix:
assumes "circline_set H' ≠ {}"
shows "circline_set (moebius_circline M H) = circline_set H' ⟷
moebius_circline M H = H'"
using assms
by auto (rule inj_circline_set, auto)
lemma unit_circle_fix_iff_unit_circle_set:
shows "unit_circle_fix M ⟷ moebius_pt M ` unit_circle_set = unit_circle_set"
proof-
have "circline_set unit_circle ≠ {}"
using one_in_unit_circle_set
by auto
thus ?thesis
using unit_circle_fix_iff[of M] circline_set_fix_iff_circline_fix[of unit_circle M unit_circle]
by (simp add: unit_circle_set_def)
qed
text ‹Unit circle preserving Möbius transformations form a group. ›
lemma unit_circle_fix_id_moebius [simp]:
shows "unit_circle_fix id_moebius"
by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
lemma unit_circle_fix_moebius_add [simp]:
assumes "unit_circle_fix M1" and "unit_circle_fix M2"
shows "unit_circle_fix (M1 + M2)"
using assms
unfolding unit_circle_fix_iff
by auto
lemma unit_circle_fix_moebius_comp [simp]:
assumes "unit_circle_fix M1" and "unit_circle_fix M2"
shows "unit_circle_fix (moebius_comp M1 M2)"
using unit_circle_fix_moebius_add[OF assms]
by simp
lemma unit_circle_fix_moebius_uminus [simp]:
assumes "unit_circle_fix M"
shows "unit_circle_fix (-M)"
using assms
unfolding unit_circle_fix_iff
by (metis moebius_circline_comp_inv_left uminus_moebius_def)
lemma unit_circle_fix_moebius_inv [simp]:
assumes "unit_circle_fix M"
shows "unit_circle_fix (moebius_inv M)"
using unit_circle_fix_moebius_uminus[OF assms]
by simp
text ‹Unit circle fixing transforms preserve inverse points.›
lemma unit_circle_fix_moebius_pt_inversion [simp]:
assumes "unit_circle_fix M"
shows "moebius_pt M (inversion z) = inversion (moebius_pt M z)"
using assms
using symmetry_principle[of z "inversion z" unit_circle M]
using unit_circle_fix_iff[of M, symmetric]
using circline_symmetric_inv_homo_disc[of z]
using circline_symmetric_inv_homo_disc'[of "moebius_pt M z" "moebius_pt M (inversion z)"]
by metis
subsection ‹Möbius transformations that fix the imaginary unit circle›
text ‹Only for completeness we show that Möbius transformations that preserve the imaginary unit
circle are exactly those characterised by generalized unitary matrices (with the (2, 0) signature).›
lemma imag_unit_circle_fixed_iff_unitary_gen:
assumes "mat_det (A, B, C, D) ≠ 0"
shows "moebius_circline (mk_moebius A B C D) imag_unit_circle = imag_unit_circle ⟷
unitary_gen (A, B, C, D)" (is "?lhs = ?rhs")
proof
assume ?lhs
thus ?rhs
using assms
proof (transfer, transfer)
fix A B C D :: complex
let ?M = "(A, B, C, D)" and ?E = "(1, 0, 0, 1)"
assume "circline_eq_cmat (moebius_circline_cmat_cmat (mk_moebius_cmat A B C D) imag_unit_circle_cmat) imag_unit_circle_cmat"
"mat_det ?M ≠ 0"
then obtain k where "k ≠ 0" "?E = cor k *⇩s⇩m congruence (mat_inv ?M) ?E"
by auto
hence "unitary_gen (mat_inv ?M)"
using mult_sm_inv_l[of "cor k" "congruence (mat_inv ?M) ?E" "?E"]
unfolding unitary_gen_def
by (metis congruence_def divide_eq_0_iff eye_def mat_eye_r of_real_eq_0_iff one_neq_zero)
thus "unitary_gen ?M"
using unitary_gen_inv[of "mat_inv ?M"] ‹mat_det ?M ≠ 0›
by (simp del: mat_inv.simps)
qed
next
assume ?rhs
thus ?lhs
using assms
proof (transfer, transfer)
fix A B C D :: complex
let ?M = "(A, B, C, D)" and ?E = "(1, 0, 0, 1)"
assume "unitary_gen ?M" "mat_det ?M ≠ 0"
hence "unitary_gen (mat_inv ?M)"
using unitary_gen_inv[of ?M]
by simp
then obtain k where "k ≠ 0" "mat_adj (mat_inv ?M) *⇩m⇩m (mat_inv ?M) = cor k *⇩s⇩m eye"
using unitary_gen_real[of "mat_inv ?M"] mat_det_inv[of ?M]
by auto
hence *: "?E = (1 / cor k) *⇩s⇩m (mat_adj (mat_inv ?M) *⇩m⇩m (mat_inv ?M))"
using mult_sm_inv_l[of "cor k" eye "mat_adj (mat_inv ?M) *⇩m⇩m (mat_inv ?M)"]
by simp
have "∃k. k ≠ 0 ∧
(1, 0, 0, 1) = cor k *⇩s⇩m (mat_adj (mat_inv (A, B, C, D)) *⇩m⇩m (1, 0, 0, 1) *⇩m⇩m mat_inv (A, B, C, D))"
using ‹mat_det ?M ≠ 0› ‹k ≠ 0›
by (metis "*" Im_complex_of_real Re_complex_of_real ‹mat_adj (mat_inv ?M) *⇩m⇩m mat_inv ?M = cor k *⇩s⇩m eye› complex_of_real_Re eye_def mat_eye_l mult_mm_assoc mult_mm_sm mult_sm_eye_mm of_real_1 of_real_divide of_real_eq_1_iff zero_eq_1_divide_iff)
thus "circline_eq_cmat (moebius_circline_cmat_cmat (mk_moebius_cmat A B C D) imag_unit_circle_cmat) imag_unit_circle_cmat"
using ‹mat_det ?M ≠ 0› ‹k ≠ 0›
by (simp del: mat_inv.simps)
qed
qed
subsection ‹Möbius transformations that fix the oriented unit circle and the unit disc›
text ‹Möbius transformations that fix the unit circle either map the unit disc onto itself or
exchange it with its exterior. The transformations that fix the unit disc can be recognized from
their matrices -- they have the form as before, but additionally it must hold that $|a|^2 > |b|^2$.›
definition unit_disc_fix_cmat :: "complex_mat ⇒ bool" where
[simp]: "unit_disc_fix_cmat M ⟷
(let (A, B, C, D) = M
in unitary11_gen (A, B, C, D) ∧ (B = 0 ∨ Re ((A*D)/(B*C)) > 1))"
lift_definition unit_disc_fix_mmat :: "moebius_mat ⇒ bool" is unit_disc_fix_cmat
done
lift_definition unit_disc_fix :: "moebius ⇒ bool" is unit_disc_fix_mmat
proof transfer
fix M M' :: complex_mat
assume det: "mat_det M ≠ 0" "mat_det M' ≠ 0"
assume "moebius_cmat_eq M M'"
then obtain k where *: "k ≠ 0" "M' = k *⇩s⇩m M"
by auto
hence **: "unitary11_gen M ⟷ unitary11_gen M'"
using unitary11_gen_mult_sm[of k M] unitary11_gen_div_sm[of k M]
by auto
obtain A B C D where MM: "(A, B, C, D) = M"
by (cases M) auto
obtain A' B' C' D' where MM': "(A', B', C', D') = M'"
by (cases M') auto
show "unit_disc_fix_cmat M = unit_disc_fix_cmat M'"
using * ** MM MM'
by auto
qed
text ‹Transformations that fix the unit disc also fix the unit circle.›
lemma unit_disc_fix_unit_circle_fix [simp]:
assumes "unit_disc_fix M"
shows "unit_circle_fix M"
using assms
by (transfer, transfer, auto)
text ‹Transformations that preserve the unit disc preserve the orientation of the unit circle.›
lemma unit_disc_fix_iff_ounit_circle:
shows "unit_disc_fix M ⟷
moebius_ocircline M ounit_circle = ounit_circle" (is "?rhs ⟷ ?lhs")
proof
assume *: ?lhs
have "moebius_circline M unit_circle = unit_circle"
apply (subst moebius_circline_ocircline[of M unit_circle])
apply (subst of_circline_unit_circle)
apply (subst *)
by simp
hence "unit_circle_fix M"
by (simp add: unit_circle_fix_iff)
thus ?rhs
using *
proof (transfer, transfer)
fix M :: complex_mat
assume "mat_det M ≠ 0"
let ?H = "(1, 0, 0, -1)"
obtain A B C D where MM: "(A, B, C, D) = M"
by (cases M) auto
assume "unitary11_gen M" "ocircline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
then obtain k where "0 < k" "?H = cor k *⇩s⇩m congruence (mat_inv M) ?H"
by auto
hence "congruence M ?H = cor k *⇩s⇩m ?H"
using congruence_inv[of "mat_inv M" "?H" "(1/cor k) *⇩s⇩m ?H"] ‹mat_det M ≠ 0›
using mult_sm_inv_l[of "cor k" "congruence (mat_inv M) ?H" "?H"]
using mult_sm_inv_l[of "1/cor k" "congruence M ?H"]
using congruence_scale_m[of M "1/cor k" "?H"]
using ‹⋀B. ⟦1 / cor k ≠ 0; (1 / cor k) *⇩s⇩m congruence M (1, 0, 0, - 1) = B⟧ ⟹ congruence M (1, 0, 0, - 1) = (1 / (1 / cor k)) *⇩s⇩m B›
by (auto simp add: mat_det_inv)
then obtain a b k' where "k' ≠ 0" "M = k' *⇩s⇩m (a, b, cnj b, cnj a)" "sgn (Re (mat_det (a, b, cnj b, cnj a))) = 1"
using unitary11_sgn_det_orientation'[of M k] ‹k > 0›
by auto
moreover
have "mat_det (a, b, cnj b, cnj a) ≠ 0"
using ‹sgn (Re (mat_det (a, b, cnj b, cnj a))) = 1›
by (smt sgn_0 zero_complex.simps(1))
ultimately
show "unit_disc_fix_cmat M"
using unitary11_sgn_det[of k' a b M A B C D]
using MM[symmetric] ‹k > 0› ‹unitary11_gen M›
by (simp add: sgn_1_pos split: if_split_asm)
qed
next
assume ?rhs
thus ?lhs
proof (transfer, transfer)
fix M :: complex_mat
assume "mat_det M ≠ 0"
obtain A B C D where MM: "(A, B, C, D) = M"
by (cases M) auto
assume "unit_disc_fix_cmat M"
hence "unitary11_gen M" "B = 0 ∨ 1 < Re (A * D / (B * C))"
using MM[symmetric]
by auto
have "sgn (if B = 0 then 1 else sgn (Re (A * D / (B * C)) - 1)) = 1"
using ‹B = 0 ∨ 1 < Re (A * D / (B * C))›
by auto
then obtain k' where "k' > 0" "congruence M (1, 0, 0, -1) = cor k' *⇩s⇩m (1, 0, 0, -1)"
using unitary11_orientation[OF ‹unitary11_gen M› MM[symmetric]]
by (auto simp add: sgn_1_pos)
thus "ocircline_eq_cmat (moebius_circline_cmat_cmat M unit_circle_cmat) unit_circle_cmat"
using congruence_inv[of M "(1, 0, 0, -1)" "cor k' *⇩s⇩m (1, 0, 0, -1)"] ‹mat_det M ≠ 0›
using congruence_scale_m[of "mat_inv M" "cor k'" "(1, 0, 0, -1)"]
by auto
qed
qed
text ‹Our algebraic characterisation (by matrices) is geometrically correct.›
lemma unit_disc_fix_iff [simp]:
assumes "unit_disc_fix M"
shows "moebius_pt M ` unit_disc = unit_disc"
using assms
using unit_disc_fix_iff_ounit_circle[of M]
unfolding unit_disc_def
by (subst disc_moebius_ocircline[symmetric], simp)
lemma unit_disc_fix_discI [simp]:
assumes "unit_disc_fix M" and "u ∈ unit_disc"
shows "moebius_pt M u ∈ unit_disc"
using unit_disc_fix_iff assms
by blast
text ‹Unit disc preserving transformations form a group.›
lemma unit_disc_fix_id_moebius [simp]:
shows "unit_disc_fix id_moebius"
by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
lemma unit_disc_fix_moebius_add [simp]:
assumes "unit_disc_fix M1" and "unit_disc_fix M2"
shows "unit_disc_fix (M1 + M2)"
using assms
unfolding unit_disc_fix_iff_ounit_circle
by auto
lemma unit_disc_fix_moebius_comp [simp]:
assumes "unit_disc_fix M1" and "unit_disc_fix M2"
shows "unit_disc_fix (moebius_comp M1 M2)"
using unit_disc_fix_moebius_add[OF assms]
by simp
lemma unit_disc_fix_moebius_uminus [simp]:
assumes "unit_disc_fix M"
shows "unit_disc_fix (-M)"
using assms
unfolding unit_disc_fix_iff_ounit_circle
by (metis moebius_ocircline_comp_inv_left uminus_moebius_def)
lemma unit_disc_fix_moebius_inv [simp]:
assumes "unit_disc_fix M"
shows "unit_disc_fix (moebius_inv M)"
using unit_disc_fix_moebius_uminus[OF assms]
by simp
subsection ‹Rotations are unit disc preserving transformations›
lemma unit_disc_fix_rotation [simp]:
shows "unit_disc_fix (moebius_rotation φ)"
unfolding moebius_rotation_def moebius_similarity_def
by (transfer, transfer, simp add: unitary11_gen_def mat_adj_def mat_cnj_def cis_mult)
lemma moebius_rotation_unit_circle_fix [simp]:
shows "moebius_pt (moebius_rotation φ) u ∈ unit_circle_set ⟷ u ∈ unit_circle_set"
using moebius_pt_moebius_inv_in_set unit_circle_fix_iff_unit_circle_set
by fastforce
lemma ex_rotation_mapping_u_to_positive_x_axis:
assumes "u ≠ 0⇩h" and "u ≠ ∞⇩h"
shows "∃ φ. moebius_pt (moebius_rotation φ) u ∈ positive_x_axis"
proof-
from assms obtain c where *: "u = of_complex c"
using inf_or_of_complex
by blast
have "is_real (cis (- arg c) * c)" "Re (cis (-arg c) * c) > 0"
using "*" assms is_real_rot_to_x_axis positive_rot_to_x_axis of_complex_zero_iff
by blast+
thus ?thesis
using *
by (rule_tac x="-arg c" in exI) (simp add: positive_x_axis_def circline_set_x_axis)
qed
lemma ex_rotation_mapping_u_to_positive_y_axis:
assumes "u ≠ 0⇩h" and "u ≠ ∞⇩h"
shows "∃ φ. moebius_pt (moebius_rotation φ) u ∈ positive_y_axis"
proof-
from assms obtain c where *: "u = of_complex c"
using inf_or_of_complex
by blast
have "is_imag (cis (pi/2 - arg c) * c)" "Im (cis (pi/2 - arg c) * c) > 0"
using "*" assms is_real_rot_to_x_axis positive_rot_to_x_axis of_complex_zero_iff
by - (simp, simp, simp add: field_simps)
thus ?thesis
using *
by (rule_tac x="pi/2-arg c" in exI) (simp add: positive_y_axis_def circline_set_y_axis)
qed
lemma wlog_rotation_to_positive_x_axis:
assumes in_disc: "u ∈ unit_disc" and not_zero: "u ≠ 0⇩h"
assumes preserving: "⋀φ u. ⟦u ∈ unit_disc; u ≠ 0⇩h; P (moebius_pt (moebius_rotation φ) u)⟧ ⟹ P u"
assumes x_axis: "⋀x. ⟦is_real x; 0 < Re x; Re x < 1⟧ ⟹ P (of_complex x)"
shows "P u"
proof-
from in_disc obtain φ where *:
"moebius_pt (moebius_rotation φ) u ∈ positive_x_axis"
using ex_rotation_mapping_u_to_positive_x_axis[of u]
using inf_notin_unit_disc not_zero
by blast
let ?Mu = "moebius_pt (moebius_rotation φ) u"
have "P ?Mu"
proof-
let ?x = "to_complex ?Mu"
have "?Mu ∈ unit_disc" "?Mu ≠ 0⇩h" "?Mu ≠ ∞⇩h"
using ‹u ∈ unit_disc› ‹u ≠ 0⇩h›
by auto
hence "is_real (to_complex ?Mu)" "0 < Re ?x" "Re ?x < 1"
using *
unfolding positive_x_axis_def circline_set_x_axis
by (auto simp add: cmod_eq_Re)
thus ?thesis
using x_axis[of ?x] ‹?Mu ≠ ∞⇩h›
by simp
qed
thus ?thesis
using preserving[OF in_disc] not_zero
by simp
qed
lemma wlog_rotation_to_positive_x_axis':
assumes not_zero: "u ≠ 0⇩h" and not_inf: "u ≠ ∞⇩h"
assumes preserving: "⋀φ u. ⟦u ≠ 0⇩h; u ≠ ∞⇩h; P (moebius_pt (moebius_rotation φ) u)⟧ ⟹ P u"
assumes x_axis: "⋀x. ⟦is_real x; 0 < Re x⟧ ⟹ P (of_complex x)"
shows "P u"
proof-
from not_zero and not_inf obtain φ where *:
"moebius_pt (moebius_rotation φ) u ∈ positive_x_axis"
using ex_rotation_mapping_u_to_positive_x_axis[of u]
using inf_notin_unit_disc
by blast
let ?Mu = "moebius_pt (moebius_rotation φ) u"
have "P ?Mu"
proof-
let ?x = "to_complex ?Mu"
have "?Mu ≠ 0⇩h" "?Mu ≠ ∞⇩h"
using ‹u ≠ ∞⇩h› ‹u ≠ 0⇩h›
by auto
hence "is_real (to_complex ?Mu)" "0 < Re ?x"
using *
unfolding positive_x_axis_def circline_set_x_axis
by (auto simp add: cmod_eq_Re)
thus ?thesis
using x_axis[of ?x] ‹?Mu ≠ ∞⇩h›
by simp
qed
thus ?thesis
using preserving[OF not_zero not_inf]
by simp
qed
lemma wlog_rotation_to_positive_y_axis:
assumes in_disc: "u ∈ unit_disc" and not_zero: "u ≠ 0⇩h"
assumes preserving: "⋀φ u. ⟦u ∈ unit_disc; u ≠ 0⇩h; P (moebius_pt (moebius_rotation φ) u)⟧ ⟹ P u"
assumes y_axis: "⋀x. ⟦is_imag x; 0 < Im x; Im x < 1⟧ ⟹ P (of_complex x)"
shows "P u"
proof-
from in_disc and not_zero obtain φ where *:
"moebius_pt (moebius_rotation φ) u ∈ positive_y_axis"
using ex_rotation_mapping_u_to_positive_y_axis[of u]
using inf_notin_unit_disc
by blast
let ?Mu = "moebius_pt (moebius_rotation φ) u"
have "P ?Mu"
proof-
let ?y = "to_complex ?Mu"
have "?Mu ∈ unit_disc" "?Mu ≠ 0⇩h" "?Mu ≠ ∞⇩h"
using ‹u ∈ unit_disc› ‹u ≠ 0⇩h›
by auto
hence "is_imag (to_complex ?Mu)" "0 < Im ?y" "Im ?y < 1"
using *
unfolding positive_y_axis_def circline_set_y_axis
by (auto simp add: cmod_eq_Im)
thus ?thesis
using y_axis[of ?y] ‹?Mu ≠ ∞⇩h›
by simp
qed
thus ?thesis
using preserving[OF in_disc not_zero]
by simp
qed
subsection ‹Blaschke factors are unit disc preserving transformations›
text ‹For a given point $a$, Blaschke factor transformations are of the form $k \cdot
\left(\begin{array}{cc}1 & -a\\ -\overline{a} & 1\end{array}\right)$. It is a disc preserving
Möbius transformation that maps the point $a$ to zero (by the symmetry principle, it must map the
inverse point of $a$ to infinity).›
definition blaschke_cmat :: "complex ⇒ complex_mat" where
[simp]: "blaschke_cmat a = (if cmod a ≠ 1 then (1, -a, -cnj a, 1) else eye)"
lift_definition blaschke_mmat :: "complex ⇒ moebius_mat" is blaschke_cmat
by simp
lift_definition blaschke :: "complex ⇒ moebius" is blaschke_mmat
done
lemma blaschke_0_id [simp]: "blaschke 0 = id_moebius"
by (transfer, transfer, simp)
lemma blaschke_a_to_zero [simp]:
assumes "cmod a ≠ 1"
shows "moebius_pt (blaschke a) (of_complex a) = 0⇩h"
using assms
by (transfer, transfer, simp)
lemma blaschke_inv_a_inf [simp]:
assumes "cmod a ≠ 1"
shows "moebius_pt (blaschke a) (inversion (of_complex a)) = ∞⇩h"
using assms
unfolding inversion_def
by (transfer, transfer) (simp add: vec_cnj_def, rule_tac x="1/(1 - a*cnj a)" in exI, simp)
lemma blaschke_inf [simp]:
assumes "cmod a < 1" and "a ≠ 0"
shows "moebius_pt (blaschke a) ∞⇩h = of_complex (- 1 / cnj a)"
using assms
by (transfer, transfer, simp add: complex_mod_sqrt_Re_mult_cnj)
lemma blaschke_0_minus_a [simp]:
assumes "cmod a ≠ 1"
shows "moebius_pt (blaschke a) 0⇩h = ~⇩h (of_complex a)"
using assms
by (transfer, transfer, simp)
lemma blaschke_unit_circle_fix [simp]:
assumes "cmod a ≠ 1"
shows "unit_circle_fix (blaschke a)"
using assms
by (transfer, transfer) (simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
lemma blaschke_unit_disc_fix [simp]:
assumes "cmod a < 1"
shows "unit_disc_fix (blaschke a)"
using assms
proof (transfer, transfer)
fix a
assume *: "cmod a < 1"
show "unit_disc_fix_cmat (blaschke_cmat a)"
proof (cases "a = 0")
case True
thus ?thesis
by (simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
next
case False
hence "Re (a * cnj a) < 1"
using *
by (metis complex_mod_sqrt_Re_mult_cnj real_sqrt_lt_1_iff)
hence "1 / Re (a * cnj a) > 1"
using False
by (smt complex_div_gt_0 less_divide_eq_1_pos one_complex.simps(1) right_inverse_eq)
hence "Re (1 / (a * cnj a)) > 1"
by (simp add: complex_is_Real_iff)
thus ?thesis
by (simp add: unitary11_gen_def mat_adj_def mat_cnj_def)
qed
qed
lemma blaschke_unit_circle_fix':
assumes "cmod a ≠ 1"
shows "moebius_circline (blaschke a) unit_circle = unit_circle"
using assms
using blaschke_unit_circle_fix unit_circle_fix_iff
by simp
lemma blaschke_ounit_circle_fix':
assumes "cmod a < 1"
shows "moebius_ocircline (blaschke a) ounit_circle = ounit_circle"
proof-
have "Re (a * cnj a) < 1"
using assms
by (metis complex_mod_sqrt_Re_mult_cnj real_sqrt_lt_1_iff)
thus ?thesis
using assms
using blaschke_unit_disc_fix unit_disc_fix_iff_ounit_circle
by simp
qed
lemma moebius_pt_blaschke [simp]:
assumes "cmod a ≠ 1" and "z ≠ 1 / cnj a"
shows "moebius_pt (blaschke a) (of_complex z) = of_complex ((z - a) / (1 - cnj a * z))"
using assms
proof (cases "a = 0")
case True
thus ?thesis
by auto
next
case False
thus ?thesis
using assms
apply (transfer, transfer)
apply (simp add: complex_mod_sqrt_Re_mult_cnj)
apply (rule_tac x="1 / (1 - cnj a * z)" in exI)
apply (simp add: field_simps)
done
qed
subsubsection ‹Blaschke factors for a real point $a$›
text ‹If the point $a$ is real, the Blaschke factor preserve x-axis and the upper and the lower
halfplane.›
lemma blaschke_real_preserve_x_axis [simp]:
assumes "is_real a" and "cmod a < 1"
shows "moebius_pt (blaschke a) z ∈ circline_set x_axis ⟷ z ∈ circline_set x_axis"
proof (cases "a = 0")
case True
thus ?thesis
by simp
next
case False
have "cmod a ≠ 1"
using assms
by linarith
let ?a = "of_complex a"
let ?i = "inversion ?a"
let ?M = "moebius_pt (blaschke a)"
have *: "?M ?a = 0⇩h" "?M ?i = ∞⇩h" "?M 0⇩h = of_complex (-a)"
using ‹cmod a ≠ 1› blaschke_a_to_zero[of a] blaschke_inv_a_inf[of a] blaschke_0_minus_a[of a]
by auto
let ?Mx = "moebius_circline (blaschke a) x_axis"
have "?a ∈ circline_set x_axis" "?i ∈ circline_set x_axis" "0⇩h ∈ circline_set x_axis"
using ‹is_real a› ‹a ≠ 0› eq_cnj_iff_real[of a]
by auto
hence "0⇩h ∈ circline_set ?Mx" "∞⇩h ∈ circline_set ?Mx" "of_complex (-a) ∈ circline_set ?Mx"
using *
apply -
apply (force simp add: image_iff)+
apply (simp add: image_iff, rule_tac x="0⇩h" in bexI, simp_all)
done
moreover
have "0⇩h ∈ circline_set x_axis" "∞⇩h ∈ circline_set x_axis" "of_complex (-a) ∈ circline_set x_axis"
using ‹is_real a›
by auto
moreover
have "of_complex (-a) ≠ 0⇩h"
using ‹a ≠ 0›
by simp
hence "0⇩h ≠ of_complex (-a)"
by metis
hence "∃!H. 0⇩h ∈ circline_set H ∧ ∞⇩h ∈ circline_set H ∧ of_complex (- a) ∈ circline_set H"
using unique_circline_set[of "0⇩h" "∞⇩h" "of_complex (-a)"] ‹a ≠ 0›
by simp
ultimately
have "moebius_circline (blaschke a) x_axis = x_axis"
by auto
thus ?thesis
by (metis circline_set_moebius_circline_iff)
qed
lemma blaschke_real_preserve_sgn_Im [simp]:
assumes "is_real a" and "cmod a < 1" and "z ≠ ∞⇩h" and "z ≠ inversion (of_complex a)"
shows "sgn (Im (to_complex (moebius_pt (blaschke a) z))) = sgn (Im (to_complex z))"
proof (cases "a = 0")
case True
thus ?thesis
by simp
next
case False
obtain z' where z': "z = of_complex z'"
using inf_or_of_complex[of z] ‹z ≠ ∞⇩h›
by auto
have "z' ≠ 1 / cnj a"
using assms z' ‹a ≠ 0›
by (auto simp add: of_complex_inj)
moreover
have "a * cnj a ≠ 1"
using ‹cmod a < 1›
by auto (simp add: complex_mod_sqrt_Re_mult_cnj)
moreover
have "sgn (Im ((z' - a) / (1 - a * z'))) = sgn (Im z')"
proof-
have "a * z' ≠ 1"
using ‹is_real a› ‹z' ≠ 1 / cnj a› ‹a ≠ 0› eq_cnj_iff_real[of a]
by (simp add: field_simps)
moreover
have "Re (1 - a⇧2) > 0"
using ‹is_real a› ‹cmod a < 1›
by (smt Re_power2 minus_complex.simps(1) norm_complex_def one_complex.simps(1) power2_less_0 real_sqrt_lt_1_iff)
moreover
have "Im ((z' - a) / (1 - a * z')) = Re (((1 - a⇧2) * Im z') / (cmod (1 - a*z'))⇧2)"
proof-
have "1 - a * cnj z' ≠ 0"
using ‹z' ≠ 1 / cnj a›
by (metis Im_complex_div_eq_0 complex_cnj_zero_iff diff_eq_diff_eq diff_numeral_special(9) eq_divide_imp is_real_div mult_not_zero one_complex.simps(2) zero_neq_one)
hence "Im ((z' - a) / (1 - a * z')) = Im (((z' - a) * (1 - a * cnj z')) / ((1 - a * z') * cnj (1 - a * z')))"
using ‹is_real a› eq_cnj_iff_real[of a]
by simp
also have "... = Im ((z' - a - a * z' * cnj z' + a⇧2 * cnj z') / (cmod (1 - a*z'))⇧2)"
unfolding complex_mult_cnj_cmod
by (simp add: power2_eq_square field_simps)
finally show ?thesis
using ‹is_real a›
by (simp add: field_simps)
qed
moreover
have "0 < (1 - (Re a)⇧2) * Im z' / (cmod (1 - a * z'))⇧2 ⟹ Im z' > 0"
using ‹is_real a› ‹0 < Re (1 - a⇧2)›
by (smt Re_power_real divide_le_0_iff minus_complex.simps(1) not_sum_power2_lt_zero one_complex.simps(1) zero_less_mult_pos)
ultimately
show ?thesis
unfolding sgn_real_def
using ‹cmod a < 1› ‹a * z' ≠ 1› ‹is_real a›
by (auto simp add: cmod_eq_Re)
qed
ultimately
show ?thesis
using assms z' moebius_pt_blaschke[of a z'] ‹is_real a› eq_cnj_iff_real[of a]
by simp
qed
lemma blaschke_real_preserve_sgn_arg [simp]:
assumes "is_real a" and "cmod a < 1" and "z ∉ circline_set x_axis"
shows "sgn (arg (to_complex (moebius_pt (blaschke a) z))) = sgn (arg (to_complex z))"
proof-
have "z ≠ ∞⇩h"
using assms
using special_points_on_x_axis''(3) by blast
moreover
have "z ≠ inversion (of_complex a)"
using assms
by (metis calculation circline_equation_x_axis circline_set_x_axis_I conjugate_of_complex inversion_of_complex inversion_sym is_real_inversion o_apply of_complex_zero reciprocal_zero to_complex_of_complex)
ultimately
show ?thesis
using blaschke_real_preserve_sgn_Im[OF assms(1) assms(2), of z]
by (smt arg_Im_sgn assms(3) circline_set_x_axis_I norm_sgn of_complex_to_complex)
qed
subsubsection ‹Inverse Blaschke transform›
definition inv_blaschke_cmat :: "complex ⇒ complex_mat" where
[simp]: "inv_blaschke_cmat a = (if cmod a ≠ 1 then (1, a, cnj a, 1) else eye)"
lift_definition inv_blaschke_mmat :: "complex ⇒ moebius_mat" is inv_blaschke_cmat
by simp
lift_definition inv_blaschke :: "complex ⇒ moebius" is inv_blaschke_mmat
done
lemma inv_blaschke_neg [simp]: "inv_blaschke a = blaschke (-a)"
by (transfer, transfer) simp
lemma inv_blaschke:
assumes "cmod a ≠ 1"
shows "blaschke a + inv_blaschke a = 0"
apply simp
apply (transfer, transfer)
by auto (rule_tac x="1/(1 - a*cnj a)" in exI, simp)
lemma ex_unit_disc_fix_mapping_u_to_zero:
assumes "u ∈ unit_disc"
shows "∃ M. unit_disc_fix M ∧ moebius_pt M u = 0⇩h"
proof-
from assms obtain c where *: "u = of_complex c"
by (metis inf_notin_unit_disc inf_or_of_complex)
hence "cmod c < 1"
using assms unit_disc_iff_cmod_lt_1
by simp
thus ?thesis
using *
by (rule_tac x="blaschke c" in exI)
(smt blaschke_a_to_zero blaschke_ounit_circle_fix' unit_disc_fix_iff_ounit_circle)
qed
lemma wlog_zero:
assumes in_disc: "u ∈ unit_disc"
assumes preserving: "⋀ a u. ⟦u ∈ unit_disc; cmod a < 1; P (moebius_pt (blaschke a) u)⟧ ⟹ P u"
assumes zero: "P 0⇩h"
shows "P u"
proof-
have *: "moebius_pt (blaschke (to_complex u)) u = 0⇩h"
by (smt blaschke_a_to_zero in_disc inf_notin_unit_disc of_complex_to_complex unit_disc_iff_cmod_lt_1)
thus ?thesis
using preserving[of u "to_complex u"] in_disc zero
using inf_or_of_complex[of u]
by auto
qed
lemma wlog_real_zero:
assumes in_disc: "u ∈ unit_disc" and real: "is_real (to_complex u)"
assumes preserving: "⋀ a u. ⟦u ∈ unit_disc; is_real a; cmod a < 1; P (moebius_pt (blaschke a) u)⟧ ⟹ P u"
assumes zero: "P 0⇩h"
shows "P u"
proof-
have *: "moebius_pt (blaschke (to_complex u)) u = 0⇩h"
by (smt blaschke_a_to_zero in_disc inf_notin_unit_disc of_complex_to_complex unit_disc_iff_cmod_lt_1)
thus ?thesis
using preserving[of u "to_complex u"] in_disc zero real
using inf_or_of_complex[of u]
by auto
qed
lemma unit_disc_fix_transitive:
assumes in_disc: "u ∈ unit_disc" and "u' ∈ unit_disc"
shows "∃ M. unit_disc_fix M ∧ moebius_pt M u = u'"
proof-
have "∀ u ∈ unit_disc. ∃ M. unit_disc_fix M ∧ moebius_pt M u = u'" (is "?P u'")
proof (rule wlog_zero)
show "u' ∈ unit_disc" by fact
next
show "?P 0⇩h"
by (simp add: ex_unit_disc_fix_mapping_u_to_zero)
next
fix a u
assume "cmod a < 1" and *: "?P (moebius_pt (blaschke a) u)"
show "?P u"
proof
fix u'
assume "u' ∈ unit_disc"
then obtain M' where "unit_disc_fix M'" "moebius_pt M' u' = moebius_pt (blaschke a) u"
using *
by auto
thus "∃M. unit_disc_fix M ∧ moebius_pt M u' = u"
using ‹cmod a < 1› blaschke_unit_disc_fix[of a]
using unit_disc_fix_moebius_comp[of "- blaschke a" "M'"]
using unit_disc_fix_moebius_inv[of "blaschke a"]
by (rule_tac x="(- (blaschke a)) + M'" in exI, simp)
qed
qed
thus ?thesis
using assms
by auto
qed
subsection ‹Decomposition of unit disc preserving Möbius transforms›
text ‹Each transformation preserving unit disc can be decomposed to a rotation around the origin and
a Blaschke factors that maps a point within the unit disc to zero.›
lemma unit_disc_fix_decompose_blaschke_rotation:
assumes "unit_disc_fix M"
shows "∃ k φ. cmod k < 1 ∧ M = moebius_rotation φ + blaschke k"
using assms
unfolding moebius_rotation_def moebius_similarity_def
proof (simp, transfer, transfer)
fix M
assume *: "mat_det M ≠ 0" "unit_disc_fix_cmat M"
then obtain k a b :: complex where
**: "k ≠ 0" "mat_det (a, b, cnj b, cnj a) ≠ 0" "M = k *⇩s⇩m (a, b, cnj b, cnj a)"
using unitary11_gen_iff[of M]
by auto
have "a ≠ 0"
using * **
by auto
then obtain a' k' φ
where ***: "k' ≠ 0 ∧ a' * cnj a' ≠ 1 ∧ M = k' *⇩s⇩m (cis φ, 0, 0, 1) *⇩m⇩m (1, - a', - cnj a', 1)"
using ** unitary11_gen_cis_blaschke[of k M a b]
by auto blast
have "a' = 0 ∨ 1 < 1 / (cmod a')⇧2"
using * *** complex_mult_cnj_cmod[of a']
by simp
hence "cmod a' < 1"
by (smt less_divide_eq_1_pos norm_zero one_less_power one_power2 pos2)
thus "∃k. cmod k < 1 ∧
(∃φ. moebius_cmat_eq M (moebius_comp_cmat (mk_moebius_cmat (cis φ) 0 0 1) (blaschke_cmat k)))"
using ***
apply (rule_tac x=a' in exI)
apply simp
apply (rule_tac x=φ in exI)
apply simp
apply (rule_tac x="1/k'" in exI)
by auto
qed
lemma wlog_unit_disc_fix:
assumes "unit_disc_fix M"
assumes b: "⋀ k. cmod k < 1 ⟹ P (blaschke k)"
assumes r: "⋀ φ. P (moebius_rotation φ)"
assumes comp: "⋀M1 M2. ⟦unit_disc_fix M1; P M1; unit_disc_fix M2; P M2⟧ ⟹ P (M1 + M2)"
shows "P M"
using assms
using unit_disc_fix_decompose_blaschke_rotation[OF assms(1)]
using blaschke_unit_disc_fix
by auto
lemma ex_unit_disc_fix_to_zero_positive_x_axis:
assumes "u ∈ unit_disc" and "v ∈ unit_disc" and "u ≠ v"
shows "∃ M. unit_disc_fix M ∧
moebius_pt M u = 0⇩h ∧ moebius_pt M v ∈ positive_x_axis"
proof-
from assms obtain B where
*: "unit_disc_fix B" "moebius_pt B u = 0⇩h"
using ex_unit_disc_fix_mapping_u_to_zero
by blast
let ?v = "moebius_pt B v"
have "?v ∈ unit_disc"
using ‹v ∈ unit_disc› *
by auto
hence "?v ≠ ∞⇩h"
using inf_notin_unit_disc by auto
have "?v ≠ 0⇩h"
using ‹u ≠ v› *
by (metis moebius_pt_invert)
obtain R where
"unit_disc_fix R"
"moebius_pt R 0⇩h = 0⇩h" "moebius_pt R ?v ∈ positive_x_axis"
using ex_rotation_mapping_u_to_positive_x_axis[of ?v] ‹?v ≠ 0⇩h› ‹?v ≠ ∞⇩h›
using moebius_pt_rotation_inf_iff moebius_pt_moebius_rotation_zero unit_disc_fix_rotation
by blast
thus ?thesis
using * moebius_comp[of R B, symmetric]
using unit_disc_fix_moebius_comp
by (rule_tac x="R + B" in exI) (simp add: comp_def)
qed
lemma wlog_x_axis:
assumes in_disc: "u ∈ unit_disc" "v ∈ unit_disc"
assumes preserved: "⋀ M u v. ⟦unit_disc_fix M; u ∈ unit_disc; v ∈ unit_disc; P (moebius_pt M u) (moebius_pt M v)⟧ ⟹ P u v"
assumes axis: "⋀ x. ⟦is_real x; 0 ≤ Re x; Re x < 1⟧ ⟹ P 0⇩h (of_complex x)"
shows "P u v"
proof (cases "u = v")
case True
have "P u u" (is "?Q u")
proof (rule wlog_zero[where P="?Q"])
show "u ∈ unit_disc"
by fact
next
show "?Q 0⇩h"
using axis[of 0]
by simp
next
fix a u
assume "u ∈ unit_disc" "cmod a < 1" "?Q (moebius_pt (blaschke a) u)"
thus "?Q u"
using preserved[of "blaschke a" u u]
using blaschke_unit_disc_fix[of a]
by simp
qed
thus ?thesis
using True
by simp
next
case False
from in_disc obtain M where
*: "unit_disc_fix M" "moebius_pt M u = 0⇩h" "moebius_pt M v ∈ positive_x_axis"
using ex_unit_disc_fix_to_zero_positive_x_axis False
by auto
then obtain x where **: "moebius_pt M v = of_complex x" "is_real x"
unfolding positive_x_axis_def circline_set_x_axis
by auto
moreover
have "of_complex x ∈ unit_disc"
using ‹unit_disc_fix M› ‹v ∈ unit_disc› **
using unit_disc_fix_discI
by fastforce
hence "0 < Re x" "Re x < 1"
using ‹moebius_pt M v ∈ positive_x_axis› **
by (auto simp add: positive_x_axis_def cmod_eq_Re)
ultimately
have "P 0⇩h (of_complex x)"
using ‹is_real x› axis
by auto
thus ?thesis
using preserved[OF *(1) assms(1-2)] *(2) **(1)
by simp
qed
lemma wlog_positive_x_axis:
assumes in_disc: "u ∈ unit_disc" "v ∈ unit_disc" "u ≠ v"
assumes preserved: "⋀ M u v. ⟦unit_disc_fix M; u ∈ unit_disc; v ∈ unit_disc; u ≠ v; P (moebius_pt M u) (moebius_pt M v)⟧ ⟹ P u v"
assumes axis: "⋀ x. ⟦is_real x; 0 < Re x; Re x < 1⟧ ⟹ P 0⇩h (of_complex x)"
shows "P u v"
proof-
have "u ≠ v ⟶ P u v" (is "?Q u v")
proof (rule wlog_x_axis)
show "u ∈ unit_disc" "v ∈ unit_disc"
by fact+
next
fix M u v
assume "unit_disc_fix M" "u ∈ unit_disc" "v ∈ unit_disc"
"?Q (moebius_pt M u) (moebius_pt M v)"
thus "?Q u v"
using preserved[of M u v]
using moebius_pt_invert
by blast
next
fix x
assume "is_real x" "0 ≤ Re x" "Re x < 1"
thus "?Q 0⇩h (of_complex x)"
using axis[of x] of_complex_zero_iff[of x] complex.expand[of x 0]
by fastforce
qed
thus ?thesis
using ‹u ≠ v›
by simp
qed
subsection ‹All functions that fix the unit disc›
text ‹It can be proved that continuous functions that fix the unit disc are either actions of
Möbius transformations that fix the unit disc (homographies), or are compositions of actions of
Möbius transformations that fix the unit disc and the conjugation (antihomographies). We postulate
this as a definition, but it this characterisation could also be formally shown (we do not need this
for our further applications).›
definition unit_disc_fix_f where
"unit_disc_fix_f f ⟷
(∃ M. unit_disc_fix M ∧ (f = moebius_pt M ∨ f = moebius_pt M ∘ conjugate))"
text ‹Unit disc fixing functions really fix unit disc.›
lemma unit_disc_fix_f_unit_disc:
assumes "unit_disc_fix_f M"
shows "M ` unit_disc = unit_disc"
using assms
unfolding unit_disc_fix_f_def
using image_comp
by force
text ‹Actions of unit disc fixing Möbius transformations (unit disc fixing homographies) are unit
disc fixing functions.›
lemma unit_disc_fix_f_moebius_pt [simp]:
assumes "unit_disc_fix M"
shows "unit_disc_fix_f (moebius_pt M)"
using assms
unfolding unit_disc_fix_f_def
by auto
text ‹Compositions of unit disc fixing Möbius transformations and conjugation (unit disc fixing
antihomographies) are unit disc fixing functions.›
lemma unit_disc_fix_conjugate_moebius [simp]:
assumes "unit_disc_fix M"
shows "unit_disc_fix (conjugate_moebius M)"
proof-
have "⋀a aa ab b. ⟦1 < Re (a * b / (aa * ab)); ¬ 1 < Re (cnj a * cnj b / (cnj aa * cnj ab))⟧ ⟹ aa = 0"
by (metis cnj.simps(1) complex_cnj_divide complex_cnj_mult)
thus ?thesis
using assms
by (transfer, transfer)
(auto simp add: mat_cnj_def unitary11_gen_def mat_adj_def field_simps)
qed
lemma unit_disc_fix_conjugate_comp_moebius [simp]:
assumes "unit_disc_fix M"
shows "unit_disc_fix_f (conjugate ∘ moebius_pt M)"
using assms
apply (subst conjugate_moebius)
apply (simp add: unit_disc_fix_f_def)
apply (rule_tac x="conjugate_moebius M" in exI, simp)
done
text ‹Uniti disc fixing functions form a group under function composition.›
lemma unit_disc_fix_f_comp [simp]:
assumes "unit_disc_fix_f f1" and "unit_disc_fix_f f2"
shows "unit_disc_fix_f (f1 ∘ f2)"
using assms
apply (subst (asm) unit_disc_fix_f_def)
apply (subst (asm) unit_disc_fix_f_def)
proof safe
fix M M'
assume "unit_disc_fix M" "unit_disc_fix M'"
thus "unit_disc_fix_f (moebius_pt M ∘ moebius_pt M')"
unfolding unit_disc_fix_f_def
by (rule_tac x="M + M'" in exI) auto
next
fix M M'
assume "unit_disc_fix M" "unit_disc_fix M'"
thus "unit_disc_fix_f (moebius_pt M ∘ (moebius_pt M' ∘ conjugate))"
unfolding unit_disc_fix_f_def
by (subst comp_assoc[symmetric])+
(rule_tac x="M + M'" in exI, auto)
next
fix M M'
assume "unit_disc_fix M" "unit_disc_fix M'"
thus "unit_disc_fix_f ((moebius_pt M ∘ conjugate) ∘ moebius_pt M')"
unfolding unit_disc_fix_f_def
by (subst comp_assoc, subst conjugate_moebius, subst comp_assoc[symmetric])+
(rule_tac x="M + conjugate_moebius M'" in exI, auto)
next
fix M M'
assume "unit_disc_fix M" "unit_disc_fix M'"
thus "unit_disc_fix_f ((moebius_pt M ∘ conjugate) ∘ (moebius_pt M' ∘ conjugate))"
apply (subst comp_assoc[symmetric], subst comp_assoc)
apply (subst conjugate_moebius, subst comp_assoc, subst comp_assoc)
apply (simp add: unit_disc_fix_f_def)
apply (rule_tac x="M + conjugate_moebius M'" in exI, auto)
done
qed
lemma unit_disc_fix_f_inv:
assumes "unit_disc_fix_f M"
shows "unit_disc_fix_f (inv M)"
using assms
apply (subst (asm) unit_disc_fix_f_def)
proof safe
fix M
assume "unit_disc_fix M"
have "inv (moebius_pt M) = moebius_pt (-M)"
by (rule ext) (simp add: moebius_inv)
thus "unit_disc_fix_f (inv (moebius_pt M))"
using ‹unit_disc_fix M›
unfolding unit_disc_fix_f_def
by (rule_tac x="-M" in exI, simp)
next
fix M
assume "unit_disc_fix M"
have "inv (moebius_pt M ∘ conjugate) = conjugate ∘ inv (moebius_pt M)"
by (subst o_inv_distrib, simp_all)
also have "... = conjugate ∘ (moebius_pt (-M))"
using moebius_inv
by auto
also have "... = moebius_pt (conjugate_moebius (-M)) ∘ conjugate"
by (simp add: conjugate_moebius)
finally
show "unit_disc_fix_f (inv (moebius_pt M ∘ conjugate))"
using ‹unit_disc_fix M›
unfolding unit_disc_fix_f_def
by (rule_tac x="conjugate_moebius (-M)" in exI, simp)
qed
subsubsection ‹Action of unit disc fixing functions on circlines›
definition unit_disc_fix_f_circline where
"unit_disc_fix_f_circline f H =
(if ∃ M. unit_disc_fix M ∧ f = moebius_pt M then
moebius_circline (THE M. unit_disc_fix M ∧ f = moebius_pt M) H
else if ∃ M. unit_disc_fix M ∧ f = moebius_pt M ∘ conjugate then
(moebius_circline (THE M. unit_disc_fix M ∧ f = moebius_pt M ∘ conjugate) ∘ conjugate_circline) H
else
H)"
lemma unique_moebius_pt_conjugate:
assumes "moebius_pt M1 ∘ conjugate = moebius_pt M2 ∘ conjugate"
shows "M1 = M2"
proof-
from assms have "moebius_pt M1 = moebius_pt M2"
using conjugate_conjugate_comp rewriteL_comp_comp2 by fastforce
thus ?thesis
using unique_moebius_pt
by auto
qed
lemma unit_disc_fix_f_circline_direct:
assumes "unit_disc_fix M" and "f = moebius_pt M"
shows "unit_disc_fix_f_circline f H = moebius_circline M H"
proof-
have "M = (THE M. unit_disc_fix M ∧ f = moebius_pt M)"
using assms
using theI_unique[of "λ M. unit_disc_fix M ∧ f = moebius_pt M" M]
using unique_moebius_pt[of M]
by auto
thus ?thesis
using assms
unfolding unit_disc_fix_f_circline_def
by auto
qed
lemma unit_disc_fix_f_circline_indirect:
assumes "unit_disc_fix M" and "f = moebius_pt M ∘ conjugate"
shows "unit_disc_fix_f_circline f H = ((moebius_circline M) ∘ conjugate_circline) H"
proof-
have "¬ (∃ M. unit_disc_fix M ∧ f = moebius_pt M)"
using assms homography_antihomography_exclusive[of f]
unfolding is_homography_def is_antihomography_def is_moebius_def
by auto
moreover
have "M = (THE M. unit_disc_fix M ∧ f = moebius_pt M ∘ conjugate)"
using assms
using theI_unique[of "λ M. unit_disc_fix M ∧ f = moebius_pt M ∘ conjugate" M]
using unique_moebius_pt_conjugate[of M]
by auto
ultimately
show ?thesis
using assms
unfolding unit_disc_fix_f_circline_def
by metis
qed
text ‹Disc automorphisms - it would be nice to show that there are no disc automorphisms other than
unit disc fixing homographies and antihomographies, but this part of the theory is not yet
developed.›
definition is_disc_aut where "is_disc_aut f ⟷ bij_betw f unit_disc unit_disc"
end
Theory Riemann_Sphere
section ‹Riemann sphere›
text ‹The extended complex plane $\mathbb{C}P^1$ can be identified with a Riemann (unit) sphere
$\Sigma$ by means of stereographic projection. The sphere is projected from its north pole $N$ to
the $xOy$ plane (identified with $\mathbb{C}$). This projection establishes a bijective map $sp$
between $\Sigma \setminus \{N\}$ and the finite complex plane $\mathbb{C}$. The infinite point is
defined as the image of $N$.›
theory Riemann_Sphere
imports Homogeneous_Coordinates Circlines "HOL-Analysis.Product_Vector"
begin
text ‹Coordinates in $\mathbb{R}^3$›
type_synonym R3 = "real × real × real"
text ‹Type of points of $\Sigma$›
abbreviation unit_sphere where
"unit_sphere ≡ {(x::real, y::real, z::real). x*x + y*y + z*z = 1}"
typedef riemann_sphere = "unit_sphere"
by (rule_tac x="(1, 0, 0)" in exI) simp
setup_lifting type_definition_riemann_sphere
lemma sphere_bounds':
assumes "x*x + y*y + z*z = (1::real)"
shows "-1 ≤ x ∧ x ≤ 1"
proof-
from assms have "x*x ≤ 1"
by (smt real_minus_mult_self_le)
hence "x⇧2 ≤ 1⇧2" "(- x)⇧2 ≤ 1⇧2"
by (auto simp add: power2_eq_square)
show "-1 ≤ x ∧ x ≤ 1"
proof (cases "x ≥ 0")
case True
thus ?thesis
using ‹x⇧2 ≤ 1⇧2›
by (smt power2_le_imp_le)
next
case False
thus ?thesis
using ‹(-x)⇧2 ≤ 1⇧2›
by (smt power2_le_imp_le)
qed
qed
lemma sphere_bounds:
assumes "x*x + y*y + z*z = (1::real)"
shows "-1 ≤ x ∧ x ≤ 1" "-1 ≤ y ∧ y ≤ 1" "-1 ≤ z ∧ z ≤ 1"
using assms
using sphere_bounds'[of x y z] sphere_bounds'[of y x z] sphere_bounds'[of z x y]
by (auto simp add: field_simps)
subsection ‹Parametrization of the unit sphere in polar coordinates›
lemma sphere_params_on_sphere:
fixes α β :: real
assumes "x = cos α * cos β" and "y = cos α * sin β" "z = sin α"
shows "x*x + y*y + z*z = 1"
proof-
have "x*x + y*y = (cos α * cos α) * (cos β * cos β) + (cos α * cos α) * (sin β * sin β)"
using assms
by simp
hence "x*x + y*y = cos α * cos α"
using sin_cos_squared_add3[of β]
by (subst (asm) distrib_left[symmetric]) (simp add: field_simps)
thus ?thesis
using assms
using sin_cos_squared_add3[of α]
by simp
qed
lemma sphere_params:
fixes x y z :: real
assumes "x*x + y*y + z*z = 1"
shows "x = cos (arcsin z) * cos (atan2 y x) ∧ y = cos (arcsin z) * sin (atan2 y x) ∧ z = sin (arcsin z)"
proof (cases "z=1 ∨ z = -1")
case True
hence "x = 0 ∧ y = 0"
using assms
by auto
thus ?thesis
using ‹z = 1 ∨ z = -1›
by (auto simp add: cos_arcsin)
next
case False
hence "x ≠ 0 ∨ y ≠ 0"
using assms
by (auto simp add: square_eq_1_iff)
thus ?thesis
using real_sqrt_unique[of y "1 - z*z"]
using real_sqrt_unique[of "-y" "1 - z*z"]
using sphere_bounds[OF assms] assms
by (auto simp add: cos_arcsin cos_arctan sin_arctan power2_eq_square field_simps real_sqrt_divide atan2_def)
qed
lemma ex_sphere_params:
assumes "x*x + y*y + z*z = 1"
shows "∃ α β. x = cos α * cos β ∧ y = cos α * sin β ∧ z = sin α ∧ -pi / 2 ≤ α ∧ α ≤ pi / 2 ∧ -pi ≤ β ∧ β < pi"
using assms arcsin_bounded[of z] sphere_bounds[of x y z]
by (rule_tac x="arcsin z" in exI, rule_tac x="atan2 y x" in exI) (simp add: sphere_params arcsin_bounded atan2_bounded)
subsection ‹Stereographic and inverse stereographic projection›
text ‹Stereographic projection›
definition stereographic_r3_cvec :: "R3 ⇒ complex_vec" where
[simp]: "stereographic_r3_cvec M = (let (x, y, z) = M in
(if (x, y, z) ≠ (0, 0, 1) then
(x + 𝗂 * y, cor (1 - z))
else
(1, 0)
))"
lift_definition stereographic_r3_hcoords :: "R3 ⇒ complex_homo_coords" is stereographic_r3_cvec
by (auto split: if_split_asm simp add: cor_eq_0)
lift_definition stereographic :: "riemann_sphere ⇒ complex_homo" is stereographic_r3_hcoords
done
text ‹Inverse stereographic projection›
definition inv_stereographic_cvec_r3 :: "complex_vec ⇒ R3" where [simp]:
"inv_stereographic_cvec_r3 z = (
let (z1, z2) = z
in if z2 = 0 then
(0, 0, 1)
else
let z = z1/z2;
X = Re (2*z / (1 + z*cnj z));
Y = Im (2*z / (1 + z*cnj z));
Z = ((cmod z)⇧2 - 1) / (1 + (cmod z)⇧2)
in (X, Y, Z))"
lemma Re_stereographic:
shows "Re (2 * z / (1 + z * cnj z)) = 2 * Re z / (1 + (cmod z)⇧2)"
using one_plus_square_neq_zero
by (subst complex_mult_cnj_cmod, subst Re_divide_real) (auto simp add: power2_eq_square)
lemma Im_stereographic:
shows "Im (2 * z / (1 + z * cnj z)) = 2 * Im z / (1 + (cmod z)⇧2)"
using one_plus_square_neq_zero
by (subst complex_mult_cnj_cmod, subst Im_divide_real) (auto simp add: power2_eq_square)
lemma inv_stereographic_on_sphere:
assumes "X = Re (2*z / (1 + z*cnj z))" and "Y = Im (2*z / (1 + z*cnj z))" and "Z = ((cmod z)⇧2 - 1) / (1 + (cmod z)⇧2)"
shows "X*X + Y*Y + Z*Z = 1"
proof-
have "1 + (cmod z)⇧2 ≠ 0"
by (smt power2_less_0)
thus ?thesis
using assms
by (simp add: Re_stereographic Im_stereographic)
(cases z, simp add: power2_eq_square real_sqrt_mult[symmetric] add_divide_distrib[symmetric], simp add: complex_norm power2_eq_square field_simps)
qed
lift_definition inv_stereographic_hcoords_r3 :: "complex_homo_coords ⇒ R3" is inv_stereographic_cvec_r3
done
lift_definition inv_stereographic :: "complex_homo ⇒ riemann_sphere" is inv_stereographic_hcoords_r3
proof transfer
fix v v'
assume 1: "v ≠ vec_zero" "v' ≠ vec_zero" "v ≈⇩v v'"
obtain v1 v2 v'1 v'2 where *: "v = (v1, v2)" "v' = (v'1, v'2)"
by (cases v, cases v', auto)
obtain x y z where
**: "inv_stereographic_cvec_r3 v = (x, y, z)"
by (cases "inv_stereographic_cvec_r3 v", blast)
have "inv_stereographic_cvec_r3 v ∈ unit_sphere"
proof (cases "v2 = 0")
case True
thus ?thesis
using *
by simp
next
case False
thus ?thesis
using * ** inv_stereographic_on_sphere[of x "v1 / v2" y z]
by (simp add: norm_divide)
qed
moreover
have "inv_stereographic_cvec_r3 v = inv_stereographic_cvec_r3 v'"
using 1 * **
by (auto split: if_split if_split_asm)
ultimately
show "inv_stereographic_cvec_r3 v ∈ unit_sphere ∧
inv_stereographic_cvec_r3 v = inv_stereographic_cvec_r3 v'"
by simp
qed
text ‹North pole›
definition North_R3 :: R3 where
[simp]: "North_R3 = (0, 0, 1)"
lift_definition North :: "riemann_sphere" is North_R3
by simp
lemma stereographic_North:
shows "stereographic x = ∞⇩h ⟷ x = North"
by (transfer, transfer, auto split: if_split_asm)
text ‹Stereographic and inverse stereographic projection are mutually inverse.›
lemma stereographic_inv_stereographic':
assumes
z: "z = z1/z2" and "z2 ≠ 0" and
X: "X = Re (2*z / (1 + z*cnj z))" and Y: "Y = Im (2*z / (1 + z*cnj z))" and Z: "Z = ((cmod z)⇧2 - 1) / (1 + (cmod z)⇧2)"
shows "∃ k. k ≠ 0 ∧ (X + 𝗂*Y, complex_of_real (1 - Z)) = k *⇩s⇩v (z1, z2)"
proof-
have "1 + (cmod z)⇧2 ≠ 0"
by (metis one_power2 sum_power2_eq_zero_iff zero_neq_one)
hence "(1 - Z) = 2 / (1 + (cmod z)⇧2)"
using Z
by (auto simp add: field_simps)
hence "cor (1 - Z) = 2 / cor (1 + (cmod z)⇧2)"
by auto
moreover
have "X = 2 * Re(z) / (1 + (cmod z)⇧2)"
using X
by (simp add: Re_stereographic)
have "Y = 2 * Im(z) / (1 + (cmod z)⇧2)"
using Y
by (simp add: Im_stereographic)
have "X + 𝗂*Y = 2 * z / cor (1 + (cmod z)⇧2)"
using ‹1 + (cmod z)⇧2 ≠ 0›
unfolding Complex_eq[of X Y, symmetric]
by (subst ‹X = 2*Re(z) / (1 + (cmod z)⇧2)›, subst ‹Y = 2*Im(z) / (1 + (cmod z)⇧2)›, simp add: Complex_scale4 Complex_scale1)
moreover
have "1 + (cor (cmod (z1 / z2)))⇧2 ≠ 0"
by (rule one_plus_square_neq_zero)
ultimately
show ?thesis
using ‹z2 ≠ 0› ‹1 + (cmod z)⇧2 ≠ 0›
by (simp, subst z)+
(rule_tac x="(2 / (1 + (cor (cmod (z1 / z2)))⇧2)) / z2" in exI, auto)
qed
lemma stereographic_inv_stereographic [simp]:
shows "stereographic (inv_stereographic w) = w"
proof-
have "w = stereographic (inv_stereographic w)"
proof (transfer, transfer)
fix w
assume "w ≠ vec_zero"
obtain w1 w2 where *: "w = (w1, w2)"
by (cases w, auto)
obtain x y z where **: "inv_stereographic_cvec_r3 w = (x, y, z)"
by (cases "inv_stereographic_cvec_r3 w", blast)
show "w ≈⇩v stereographic_r3_cvec (inv_stereographic_cvec_r3 w)"
using ‹w ≠ vec_zero› stereographic_inv_stereographic'[of "w1/w2" w1 w2 x y z] * **
by (auto simp add: split_def Let_def split: if_split_asm)
qed
thus ?thesis
by simp
qed
text ‹Stereographic projection is bijective function›
lemma bij_stereographic:
shows "bij stereographic"
unfolding bij_def inj_on_def surj_def
proof (safe)
fix a b
assume "stereographic a = stereographic b"
thus "a = b"
proof (transfer, transfer)
fix a b :: R3
obtain xa ya za xb yb zb where
*: "a = (xa, ya, za)" "b = (xb, yb, zb)"
by (cases a, cases b, auto)
assume **: "a ∈ unit_sphere" "b ∈ unit_sphere" "stereographic_r3_cvec a ≈⇩v stereographic_r3_cvec b"
show "a = b"
proof (cases "a = (0, 0, 1) ∨ b = (0, 0, 1)")
case True
thus ?thesis
using * **
by (simp split: if_split_asm) force+
next
case False
then obtain k where ++: "k ≠ 0" "cor xb + 𝗂 * cor yb = k * (cor xa + 𝗂 * cor ya)" "1 - cor zb = k * (1 - cor za)"
using * **
by (auto split: if_split_asm)
{
assume "xb + xa*zb = xa + xb*za"
"yb + ya*zb = ya + yb*za"
"xa*xa + ya*ya + za*za = 1" "xb*xb + yb*yb + zb*zb = 1"
"za ≠ 1" "zb ≠ 1"
hence "xa = xb ∧ ya = yb ∧ za = zb"
by algebra
} note *** = this
have "za ≠ 1" "zb ≠ 1"
using False * **
by auto
have "k = (1 - cor zb) / (1 - cor za)"
using ‹1 - cor zb = k * (1 - cor za)› ‹za ≠ 1›
by simp
hence "(1 - cor za) * (cor xb + 𝗂 * cor yb) = (1 - cor zb) * (cor xa + 𝗂 * cor ya)"
using ‹za ≠ 1› ++(2)
by simp
hence "xb + xa*zb = xa + xb*za"
"yb + ya*zb = ya + yb*za"
"xa*xa + ya*ya + za*za = 1" "xb*xb + yb*yb + zb*zb = 1"
using * ** ‹za ≠ 1›
apply (simp_all add: field_simps)
unfolding complex_of_real_def imaginary_unit.ctr
by (simp_all add: legacy_Complex_simps)
thus ?thesis
using * ** *** ‹za ≠ 1› ‹zb ≠ 1›
by simp
qed
qed
next
fix y
show "∃ x. y = stereographic x"
by (rule_tac x="inv_stereographic y" in exI, simp)
qed
lemma inv_stereographic_stereographic [simp]:
shows "inv_stereographic (stereographic x) = x"
using stereographic_inv_stereographic[of "stereographic x"]
using bij_stereographic
unfolding bij_def inj_on_def
by simp
lemma inv_stereographic_is_inv:
shows "inv_stereographic = inv stereographic"
by (rule inv_equality[symmetric], simp_all)
subsection ‹Circles on the sphere›
text ‹Circlines in the plane correspond to circles on the Riemann sphere, and we formally establish
this connection. Every circle in three--dimensional space can be obtained as the intersection of a
sphere and a plane. We establish a one-to-one correspondence between circles on the Riemann sphere
and planes in space. Note that the plane need not intersect the sphere, but we will still say that
it defines a single imaginary circle. However, for one special circline (the one with the identity
representative matrix), there does not exist a plane in $\mathbb{R}^3$ that would correspond to it
--- in order to have this, instead of considering planes in $\mathbb{R}^3$, we must consider three
dimensional projective space and consider the infinite (hyper)plane.›
text ‹Planes in $R^3$ are given by equations $ax+by+cz=d$. Two four-tuples of coefficients $(a, b, c,
d)$ give the same plane iff they are proportional.›
type_synonym R4 = "real × real × real × real"
fun mult_sv :: "real ⇒ R4 ⇒ R4" (infixl "*⇩s⇩v⇩4" 100) where
"k *⇩s⇩v⇩4 (a, b, c, d) = (k*a, k*b, k*c, k*d)"
abbreviation plane_vectors where
"plane_vectors ≡ {(a::real, b::real, c::real, d::real). a ≠ 0 ∨ b ≠ 0 ∨ c ≠ 0 ∨ d ≠ 0}"
typedef plane_vec = "plane_vectors"
by (rule_tac x="(1, 1, 1, 1)" in exI) simp
setup_lifting type_definition_plane_vec
definition plane_vec_eq_r4 :: "R4 ⇒ R4 ⇒ bool" where
[simp]: "plane_vec_eq_r4 v1 v2 ⟷ (∃ k. k ≠ 0 ∧ v2 = k *⇩s⇩v⇩4 v1)"
lift_definition plane_vec_eq :: "plane_vec ⇒ plane_vec ⇒ bool" is plane_vec_eq_r4
done
lemma mult_sv_one [simp]:
shows "1 *⇩s⇩v⇩4 x = x"
by (cases x) simp
lemma mult_sv_distb [simp]:
shows "x *⇩s⇩v⇩4 (y *⇩s⇩v⇩4 v) = (x*y) *⇩s⇩v⇩4 v"
by (cases v) simp
quotient_type plane = plane_vec / plane_vec_eq
proof (rule equivpI)
show "reflp plane_vec_eq"
unfolding reflp_def
by (auto simp add: plane_vec_eq_def) (rule_tac x="1" in exI, simp)
next
show "symp plane_vec_eq"
unfolding symp_def
by (auto simp add: plane_vec_eq_def) (rule_tac x="1/k" in exI, simp)
next
show "transp plane_vec_eq"
unfolding transp_def
by (auto simp add: plane_vec_eq_def) (rule_tac x="ka*k" in exI, simp)
qed
text ‹Plane coefficients give a linear equation and the point on the Riemann sphere lies on the
circle determined by the plane iff its representation satisfies that linear equation.›
definition on_sphere_circle_r4_r3 :: "R4 ⇒ R3 ⇒ bool" where
[simp]: "on_sphere_circle_r4_r3 α A ⟷
(let (X, Y, Z) = A;
(a, b, c, d) = α
in a*X + b*Y + c*Z + d = 0)"
lift_definition on_sphere_circle_vec :: "plane_vec ⇒ R3 ⇒ bool" is on_sphere_circle_r4_r3
done
lift_definition on_sphere_circle :: "plane ⇒ riemann_sphere ⇒ bool" is on_sphere_circle_vec
proof (transfer)
fix pv1 pv2 :: R4 and w :: R3
obtain a1 b1 c1 d1 a2 b2 c2 d2 x y z where
*: "pv1 = (a1, b1, c1, d1)" "pv2 = (a2, b2, c2, d2)" "w = (x, y, z)"
by (cases pv1, cases pv2, cases w, auto)
assume "pv1 ∈ plane_vectors" "pv2 ∈ plane_vectors" "w ∈ unit_sphere" "plane_vec_eq_r4 pv1 pv2"
then obtain k where **: "a2 = k*a1" "b2 = k*b1" "c2 = k*c1" "d2 = k*d1" "k ≠ 0"
using *
by auto
have "k * a1 * x + k * b1 * y + k * c1 * z + k * d1 = k*(a1*x + b1*y + c1*z + d1)"
by (simp add: field_simps)
thus "on_sphere_circle_r4_r3 pv1 w = on_sphere_circle_r4_r3 pv2 w"
using * **
by simp
qed
definition sphere_circle_set where
"sphere_circle_set α = {A. on_sphere_circle α A}"
subsection ‹Connections of circlines in the plane and circles on the Riemann sphere›
text ‹We introduce stereographic and inverse stereographic projection between circles on the Riemann
sphere and circlines in the extended complex plane.›
definition inv_stereographic_circline_cmat_r4 :: "complex_mat ⇒ R4" where
[simp]: "inv_stereographic_circline_cmat_r4 H =
(let (A, B, C, D) = H
in (Re (B+C), Re(𝗂*(C-B)), Re(A-D), Re(D+A)))"
lift_definition inv_stereographic_circline_clmat_pv :: "circline_mat ⇒ plane_vec" is inv_stereographic_circline_cmat_r4
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def real_imag_0 eq_cnj_iff_real)
lift_definition inv_stereographic_circline :: "circline ⇒ plane" is inv_stereographic_circline_clmat_pv
apply transfer
apply simp
apply (erule exE)
apply (rule_tac x="k" in exI)
apply (case_tac "circline_mat1", case_tac "circline_mat2")
apply (simp add: field_simps)
done
definition stereographic_circline_r4_cmat :: "R4 ⇒ complex_mat" where
[simp]: "stereographic_circline_r4_cmat α =
(let (a, b, c, d) = α
in (cor ((c+d)/2) , ((cor a + 𝗂 * cor b)/2), ((cor a - 𝗂 * cor b)/2), cor ((d-c)/2)))"
lift_definition stereographic_circline_pv_clmat :: "plane_vec ⇒ circline_mat" is stereographic_circline_r4_cmat
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def)
lift_definition stereographic_circline :: "plane ⇒ circline" is stereographic_circline_pv_clmat
apply transfer
apply transfer
apply (case_tac plane_vec1, case_tac plane_vec2, simp, erule exE, rule_tac x=k in exI, simp add: field_simps)
done
text ‹Stereographic and inverse stereographic projection of circlines are mutually inverse.›
lemma stereographic_circline_inv_stereographic_circline:
shows "stereographic_circline ∘ inv_stereographic_circline = id"
proof (rule ext, simp)
fix H
show "stereographic_circline (inv_stereographic_circline H) = H"
proof (transfer, transfer)
fix H
assume hh: "hermitean H ∧ H ≠ mat_zero"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases "H") auto
have "is_real A" "is_real D" "C = cnj B"
using HH hh hermitean_elems[of A B C D]
by auto
thus "circline_eq_cmat (stereographic_circline_r4_cmat (inv_stereographic_circline_cmat_r4 H)) H"
using HH
apply simp
apply (rule_tac x=1 in exI, cases B)
by (smt add_uminus_conv_diff complex_cnj_add complex_cnj_complex_of_real complex_cnj_i complex_cnj_mult complex_cnj_one complex_eq distrib_left_numeral mult.commute mult.left_commute mult.left_neutral mult_cancel_right2 mult_minus_left of_real_1 one_add_one)
qed
qed
text ‹Stereographic and inverse stereographic projection of circlines are mutually inverse.›
lemma inv_stereographic_circline_stereographic_circline:
"inv_stereographic_circline ∘ stereographic_circline = id"
proof (rule ext, simp)
fix α
show "inv_stereographic_circline (stereographic_circline α) = α"
proof (transfer, transfer)
fix α
assume aa: "α ∈ plane_vectors"
obtain a b c d where AA: "α = (a, b, c, d)"
by (cases "α") auto
thus "plane_vec_eq_r4 (inv_stereographic_circline_cmat_r4 (stereographic_circline_r4_cmat α)) α"
using AA
by simp (rule_tac x=1 in exI, auto simp add: field_simps complex_of_real_def)
qed
qed
lemma stereographic_sphere_circle_set'':
shows "on_sphere_circle (inv_stereographic_circline H) z ⟷
on_circline H (stereographic z)"
proof (transfer, transfer)
fix M :: R3 and H :: complex_mat
assume hh: "hermitean H ∧ H ≠ mat_zero" "M ∈ unit_sphere"
obtain A B C D where HH: "H = (A, B, C, D)"
by (cases "H") auto
have *: "is_real A" "is_real D" "C = cnj B"
using hh HH hermitean_elems[of A B C D]
by auto
obtain x y z where MM: "M = (x, y, z)"
by (cases "M") auto
show "on_sphere_circle_r4_r3 (inv_stereographic_circline_cmat_r4 H) M ⟷
on_circline_cmat_cvec H (stereographic_r3_cvec M)" (is "?lhs = ?rhs")
proof
assume ?lhs
show ?rhs
proof (cases "z=1")
case True
hence "x = 0" "y = 0"
using MM hh
by auto
thus ?thesis
using * ‹?lhs› HH MM ‹z=1›
by (cases A, simp add: vec_cnj_def Complex_eq Let_def)
next
case False
hence "Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z) = 0"
using * ‹?lhs› HH MM
by (simp add: Let_def field_simps)
hence "(Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z))*(1-z) = 0"
by simp
hence "Re A*(1+z)*(1-z) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0"
by (simp add: field_simps)
moreover
have "x*x+y*y = (1+z)*(1-z)"
using MM hh
by (simp add: field_simps)
ultimately
have "Re A*(x*x+y*y) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0"
by simp
hence "(x * Re A + (1 - z) * Re B) * x - (- (y * Re A) + - ((1 - z) * Im B)) * y + (x * Re B + y * Im B + (1 - z) * Re D) * (1 - z) = 0"
by (simp add: field_simps)
thus ?thesis
using ‹z ≠ 1› HH MM * ‹Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z) = 0›
apply (simp add: Let_def vec_cnj_def)
apply (subst complex_eq_iff)
apply (simp add: field_simps)
done
qed
next
assume ?rhs
show ?lhs
proof (cases "z=1")
case True
hence "x = 0" "y = 0"
using MM hh
by auto
thus ?thesis
using HH MM ‹?rhs› ‹z = 1›
by (simp add: Let_def vec_cnj_def)
next
case False
hence "(x * Re A + (1 - z) * Re B) * x - (- (y * Re A) + - ((1 - z) * Im B)) * y + (x * Re B + y * Im B + (1 - z) * Re D) * (1 - z) = 0"
using HH MM * ‹?rhs›
by (simp add: Let_def vec_cnj_def complex_eq_iff)
hence "Re A*(x*x+y*y) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0"
by (simp add: field_simps)
moreover
have "x*x + y*y = (1+z)*(1-z)"
using MM hh
by (simp add: field_simps)
ultimately
have "Re A*(1+z)*(1-z) + 2*Re B*x*(1-z) + 2*Im B*y*(1-z) + Re D*(1-z)*(1-z) = 0"
by simp
hence "(Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z))*(1-z) = 0"
by (simp add: field_simps)
hence "Re A*(1+z) + 2*Re B*x + 2*Im B*y + Re D*(1-z) = 0"
using ‹z ≠ 1›
by simp
thus ?thesis
using MM HH *
by (simp add: field_simps)
qed
qed
qed
lemma stereographic_sphere_circle_set' [simp]:
shows "stereographic ` sphere_circle_set (inv_stereographic_circline H) =
circline_set H"
unfolding sphere_circle_set_def circline_set_def
apply safe
proof-
fix x
assume "on_sphere_circle (inv_stereographic_circline H) x"
thus "on_circline H (stereographic x)"
using stereographic_sphere_circle_set''
by simp
next
fix x
assume "on_circline H x"
show "x ∈ stereographic ` {z. on_sphere_circle (inv_stereographic_circline H) z}"
proof
show "x = stereographic (inv_stereographic x)"
by simp
next
show "inv_stereographic x ∈ {z. on_sphere_circle (inv_stereographic_circline H) z}"
using stereographic_sphere_circle_set''[of H "inv_stereographic x"] ‹on_circline H x›
by simp
qed
qed
text ‹The projection of the set of points on a circle on the Riemann sphere is exactly the set of
points on the circline obtained by the just introduced circle stereographic projection.›
lemma stereographic_sphere_circle_set:
shows "stereographic ` sphere_circle_set H = circline_set (stereographic_circline H)"
using stereographic_sphere_circle_set'[of "stereographic_circline H"]
using inv_stereographic_circline_stereographic_circline
unfolding comp_def
by (metis id_apply)
text ‹Stereographic projection of circlines is bijective.›
lemma bij_stereographic_circline:
shows "bij stereographic_circline"
using stereographic_circline_inv_stereographic_circline inv_stereographic_circline_stereographic_circline
using o_bij by blast
text ‹Inverse stereographic projection is bijective.›
lemma bij_inv_stereographic_circline:
shows "bij inv_stereographic_circline"
using stereographic_circline_inv_stereographic_circline inv_stereographic_circline_stereographic_circline
using o_bij by blast
end
Theory Chordal_Metric
subsection ‹Chordal Metric›
text ‹Riemann sphere can be made a metric space. We are going to introduce distance on Riemann sphere
and to prove that it is a metric space. The distance between two points on the sphere is defined as
the length of the chord that connects them. This metric can be used in formalization of elliptic
geometry.›
theory Chordal_Metric
imports Homogeneous_Coordinates Riemann_Sphere Oriented_Circlines "HOL-Analysis.Inner_Product" "HOL-Analysis.Euclidean_Space"
begin
subsubsection ‹Inner product and norm›
definition inprod_cvec :: "complex_vec ⇒ complex_vec ⇒ complex" where
[simp]: "inprod_cvec z w =
(let (z1, z2) = z;
(w1, w2) = w
in vec_cnj (z1, z2) *⇩v⇩v (w1, w2))"
syntax
"_inprod_cvec" :: "complex_vec ⇒ complex_vec ⇒ complex" ("⟨_,_⟩")
translations
"⟨z,w⟩" == "CONST inprod_cvec z w"
lemma real_inprod_cvec [simp]:
shows "is_real ⟨z,z⟩"
by (cases z, simp add: vec_cnj_def)
lemma inprod_cvec_ge_zero [simp]:
shows "Re ⟨z,z⟩ ≥ 0"
by (cases z, simp add: vec_cnj_def)
lemma inprod_cvec_bilinear1 [simp]:
assumes "z' = k *⇩s⇩v z"
shows "⟨z',w⟩ = cnj k * ⟨z,w⟩"
using assms
by (cases z, cases z', cases w) (simp add: vec_cnj_def field_simps)
lemma inprod_cvec_bilinear2 [simp]:
assumes "z' = k *⇩s⇩v z"
shows "⟨w, z'⟩ = k * ⟨w, z⟩"
using assms
by (cases z, cases z', cases w) (simp add: vec_cnj_def field_simps)
lemma inprod_cvec_g_zero [simp]:
assumes "z ≠ vec_zero"
shows "Re ⟨z, z⟩ > 0"
proof-
have "∀ a b. a ≠ 0 ∨ b ≠ 0 ⟶ 0 < (Re a * Re a + Im a * Im a) + (Re b * Re b + Im b * Im b)"
by (smt complex_eq_0 not_sum_squares_lt_zero power2_eq_square)
thus ?thesis
using assms
by (cases z, simp add: vec_cnj_def)
qed
definition norm_cvec :: "complex_vec ⇒ real" where
[simp]: "norm_cvec z = sqrt (Re ⟨z,z⟩)"
syntax
"_norm_cvec" :: "complex_vec ⇒ complex" ("⟨_⟩")
translations
"⟨z⟩" == "CONST norm_cvec z"
lemma norm_cvec_square:
shows "⟨z⟩⇧2 = Re (⟨z,z⟩)"
by (simp del: inprod_cvec_def)
lemma norm_cvec_gt_0:
assumes "z ≠ vec_zero"
shows "⟨z⟩ > 0"
using assms
by (simp del: inprod_cvec_def)
lemma norm_cvec_scale:
assumes "z' = k *⇩s⇩v z"
shows "⟨z'⟩⇧2 = Re (cnj k * k) * ⟨z⟩⇧2"
unfolding norm_cvec_square
using inprod_cvec_bilinear1[OF assms, of z']
using inprod_cvec_bilinear2[OF assms, of z]
by (simp del: inprod_cvec_def add: field_simps)
lift_definition inprod_hcoords :: "complex_homo_coords ⇒ complex_homo_coords ⇒ complex" is inprod_cvec
done
lift_definition norm_hcoords :: "complex_homo_coords ⇒ real" is norm_cvec
done
subsubsection ‹Distance in $\mathbb{C}P^1$ - defined by Fubini-Study metric.›
text ‹Formula for the chordal distance between the two points can be given directly based
on the homogenous coordinates of their stereographic projections in the plane. This is
called the Fubini-Study metric.›
definition dist_fs_cvec :: "complex_vec ⇒ complex_vec ⇒ real" where [simp]:
"dist_fs_cvec z1 z2 =
(let (z1x, z1y) = z1;
(z2x, z2y) = z2;
num = (z1x*z2y - z2x*z1y) * (cnj z1x*cnj z2y - cnj z2x*cnj z1y);
den = (z1x*cnj z1x + z1y*cnj z1y) * (z2x*cnj z2x + z2y*cnj z2y)
in 2*sqrt(Re num / Re den))"
lemma dist_fs_cvec_iff:
assumes "z ≠ vec_zero" and "w ≠ vec_zero"
shows "dist_fs_cvec z w = 2*sqrt(1 - (cmod ⟨z,w⟩)⇧2 / (⟨z⟩⇧2 * ⟨w⟩⇧2))"
proof-
obtain z1 z2 w1 w2 where *: "z = (z1, z2)" "w = (w1, w2)"
by (cases "z", cases "w") auto
have 1: "2*sqrt(1 - (cmod ⟨z,w⟩)⇧2 / (⟨z⟩⇧2 * ⟨w⟩⇧2)) = 2*sqrt((⟨z⟩⇧2 * ⟨w⟩⇧2 - (cmod ⟨z,w⟩)⇧2) / (⟨z⟩⇧2 * ⟨w⟩⇧2))"
using norm_cvec_gt_0[of z] norm_cvec_gt_0[of w] assms
by (simp add: field_simps)
have 2: "⟨z⟩⇧2 * ⟨w⟩⇧2 = Re ((z1*cnj z1 + z2*cnj z2) * (w1*cnj w1 + w2*cnj w2))"
using assms *
by (simp add: vec_cnj_def)
have 3: "⟨z⟩⇧2 * ⟨w⟩⇧2 - (cmod ⟨z,w⟩)⇧2 = Re ((z1*w2 - w1*z2) * (cnj z1*cnj w2 - cnj w1*cnj z2))"
apply (subst cmod_square, (subst norm_cvec_square)+)
using *
by (simp add: vec_cnj_def field_simps)
thus ?thesis
using 1 2 3
using *
unfolding dist_fs_cvec_def Let_def
by simp
qed
lift_definition dist_fs_hcoords :: "complex_homo_coords ⇒ complex_homo_coords ⇒ real" is dist_fs_cvec
done
lift_definition dist_fs :: "complex_homo ⇒ complex_homo ⇒ real" is dist_fs_hcoords
proof transfer
fix z1 z2 z1' z2' :: complex_vec
obtain z1x z1y z2x z2y z1'x z1'y z2'x z2'y where
zz: "z1 = (z1x, z1y)" "z2 = (z2x, z2y)" "z1' = (z1'x, z1'y)" "z2' = (z2'x, z2'y)"
by (cases "z1", cases "z2", cases "z1'", cases "z2'") blast
assume 1: "z1 ≠ vec_zero" "z2 ≠ vec_zero" "z1' ≠ vec_zero" "z2' ≠ vec_zero" "z1 ≈⇩v z1'" "z2 ≈⇩v z2'"
then obtain k1 k2 where
*: "k1 ≠ 0" "z1' = k1 *⇩s⇩v z1" and
**: "k2 ≠ 0" "z2' = k2 *⇩s⇩v z2"
by auto
have "(cmod ⟨z1,z2⟩)⇧2 / (⟨z1⟩⇧2 * ⟨z2⟩⇧2) = (cmod ⟨z1',z2'⟩)⇧2 / (⟨z1'⟩⇧2 * ⟨z2'⟩⇧2)"
using ‹k1 ≠ 0› ‹k2 ≠ 0›
using cmod_square[symmetric, of k1] cmod_square[symmetric, of k2]
apply (subst norm_cvec_scale[OF *(2)])
apply (subst norm_cvec_scale[OF **(2)])
apply (subst inprod_cvec_bilinear1[OF *(2)])
apply (subst inprod_cvec_bilinear2[OF **(2)])
by (simp add: power2_eq_square norm_mult)
thus "dist_fs_cvec z1 z2 = dist_fs_cvec z1' z2'"
using 1 dist_fs_cvec_iff
by simp
qed
lemma dist_fs_finite:
shows "dist_fs (of_complex z1) (of_complex z2) = 2 * cmod(z1 - z2) / (sqrt (1+(cmod z1)⇧2) * sqrt (1+(cmod z2)⇧2))"
apply transfer
apply transfer
apply (subst cmod_square)+
apply (simp add: real_sqrt_divide cmod_def power2_eq_square)
apply (subst real_sqrt_mult[symmetric])
apply (simp add: field_simps)
done
lemma dist_fs_infinite1:
shows "dist_fs (of_complex z1) ∞⇩h = 2 / sqrt (1+(cmod z1)⇧2)"
by (transfer, transfer) (subst cmod_square, simp add: real_sqrt_divide)
lemma dist_fs_infinite2:
shows "dist_fs ∞⇩h (of_complex z1) = 2 / sqrt (1+(cmod z1)⇧2)"
by (transfer, transfer) (subst cmod_square, simp add: real_sqrt_divide)
lemma dist_fs_cvec_zero:
assumes "z ≠ vec_zero" and "w ≠ vec_zero"
shows "dist_fs_cvec z w = 0 ⟷ (cmod ⟨z,w⟩)⇧2 = (⟨z⟩⇧2 * ⟨w⟩⇧2)"
using assms norm_cvec_gt_0[of z] norm_cvec_gt_0[of w]
by (subst dist_fs_cvec_iff) auto
lemma dist_fs_zero1 [simp]:
shows "dist_fs z z = 0"
by (transfer, transfer)
(subst dist_fs_cvec_zero, simp, (subst norm_cvec_square)+, subst cmod_square, simp del: inprod_cvec_def)
lemma dist_fs_zero2 [simp]:
assumes "dist_fs z1 z2 = 0"
shows "z1 = z2"
using assms
proof (transfer, transfer)
fix z w :: complex_vec
obtain z1 z2 w1 w2 where *: "z = (z1, z2)" "w = (w1, w2)"
by (cases "z", cases "w", auto)
let ?x = "(z1*w2 - w1*z2) * (cnj z1*cnj w2 - cnj w1*cnj z2)"
assume "z ≠ vec_zero" "w ≠ vec_zero" "dist_fs_cvec z w = 0"
hence "(cmod ⟨z,w⟩)⇧2 = ⟨z⟩⇧2 * ⟨w⟩⇧2"
by (subst (asm) dist_fs_cvec_zero, simp_all)
hence "Re ?x = 0"
using *
by (subst (asm) cmod_square) ((subst (asm) norm_cvec_square)+, simp add: vec_cnj_def field_simps)
hence "?x = 0"
using complex_mult_cnj_cmod[of "z1*w2 - w1*z2"] zero_complex.simps
by (subst complex_eq_if_Re_eq[of ?x 0]) (simp add: power2_eq_square, simp, linarith)
moreover
have "z1 * w2 - w1 * z2 = 0 ⟷ cnj z1 * cnj w2 - cnj w1 * cnj z2 = 0"
by (metis complex_cnj_diff complex_cnj_mult complex_cnj_zero_iff)
ultimately
show "z ≈⇩v w"
using * ‹z ≠ vec_zero› ‹w ≠ vec_zero›
using complex_cvec_eq_mix[of z1 z2 w1 w2]
by auto
qed
lemma dist_fs_sym:
shows "dist_fs z1 z2 = dist_fs z2 z1"
by (transfer, transfer) (simp add: split_def field_simps)
subsubsection ‹Triangle inequality for Fubini-Study metric›
lemma dist_fs_triangle_finite:
shows "cmod(a - b) / (sqrt (1+(cmod a)⇧2) * sqrt (1+(cmod b)⇧2)) ≤ cmod (a - c) / (sqrt (1+(cmod a)⇧2) * sqrt (1+(cmod c)⇧2)) + cmod (c - b) / (sqrt (1+(cmod b)⇧2) * sqrt (1+(cmod c)⇧2))"
proof-
let ?cc = "1+(cmod c)⇧2" and ?bb = "1+(cmod b)⇧2" and ?aa = "1+(cmod a)⇧2"
have "sqrt ?cc > 0" "sqrt ?aa > 0" "sqrt ?bb > 0"
by (smt real_sqrt_gt_zero zero_compare_simps(12))+
have "(a - b)*(1+cnj c*c) = (a-c)*(1+cnj c*b) + (c-b)*(1 + cnj c*a)"
by (simp add: field_simps)
moreover
have "1 + cnj c * c = 1 + (cmod c)⇧2"
using complex_norm_square
by auto
hence "cmod ((a - b)*(1+cnj c*c)) = cmod(a - b) * (1+(cmod c)⇧2)"
by (smt norm_mult norm_of_real zero_compare_simps(12))
ultimately
have "cmod(a - b) * (1+(cmod c)⇧2) ≤ cmod (a-c) * cmod (1+cnj c*b) + cmod (c-b) * cmod(1 + cnj c*a)"
using complex_mod_triangle_ineq2[of "(a-c)*(1+cnj c*b)" "(c-b)*(1 + cnj c*a)"]
by (simp add: norm_mult)
moreover
have *: "⋀ a b c d b' d'. ⟦b ≤ b'; d ≤ d'; a ≥ (0::real); c ≥ 0⟧ ⟹ a*b + c*d ≤ a*b' + c*d'"
by (simp add: add_mono_thms_linordered_semiring(1) mult_left_mono)
have "cmod (a-c) * cmod (1+cnj c*b) + cmod (c-b) * cmod(1 + cnj c*a) ≤ cmod (a - c) * (sqrt (1+(cmod c)⇧2) * sqrt (1+(cmod b)⇧2)) + cmod (c - b) * (sqrt (1+(cmod c)⇧2) * sqrt (1+(cmod a)⇧2))"
using *[OF cmod_1_plus_mult_le[of "cnj c" b] cmod_1_plus_mult_le[of "cnj c" a], of "cmod (a-c)" "cmod (c-b)"]
by (simp add: field_simps real_sqrt_mult[symmetric])
ultimately
have "cmod(a - b) * ?cc ≤ cmod (a - c) * sqrt ?cc * sqrt ?bb + cmod (c - b) * sqrt ?cc * sqrt ?aa"
by simp
moreover
hence "0 ≤ ?cc * sqrt ?aa * sqrt ?bb"
using mult_right_mono[of 0 "sqrt ?aa" "sqrt ?bb"]
using mult_right_mono[of 0 "?cc" "sqrt ?aa * sqrt ?bb"]
by simp
moreover
have "sqrt ?cc / ?cc = 1 / sqrt ?cc"
using ‹sqrt ?cc > 0›
by (simp add: field_simps)
hence "sqrt ?cc / (?cc * sqrt ?aa) = 1 / (sqrt ?aa * sqrt ?cc)"
using times_divide_eq_right[of "1/sqrt ?aa" "sqrt ?cc" "?cc"]
using ‹sqrt ?aa > 0›
by simp
hence "cmod (a - c) * sqrt ?cc / (?cc * sqrt ?aa) = cmod (a - c) / (sqrt ?aa * sqrt ?cc)"
using times_divide_eq_right[of "cmod (a - c)" "sqrt ?cc" "(?cc * sqrt ?aa)"]
by simp
moreover
have "sqrt ?cc / ?cc = 1 / sqrt ?cc"
using ‹sqrt ?cc > 0›
by (simp add: field_simps)
hence "sqrt ?cc / (?cc * sqrt ?bb) = 1 / (sqrt ?bb * sqrt ?cc)"
using times_divide_eq_right[of "1/sqrt ?bb" "sqrt ?cc" "?cc"]
using ‹sqrt ?bb > 0›
by simp
hence "cmod (c - b) * sqrt ?cc / (?cc * sqrt ?bb) = cmod (c - b) / (sqrt ?bb * sqrt ?cc)"
using times_divide_eq_right[of "cmod (c - b)" "sqrt ?cc" "?cc * sqrt ?bb"]
by simp
ultimately
show ?thesis
using divide_right_mono[of "cmod (a - b) * ?cc" "cmod (a - c) * sqrt ?cc * sqrt ?bb + cmod (c - b) * sqrt ?cc * sqrt ?aa" "?cc * sqrt ?aa * sqrt ?bb"] ‹sqrt ?aa > 0› ‹sqrt ?bb > 0› ‹sqrt ?cc > 0›
by (simp add: add_divide_distrib)
qed
lemma dist_fs_triangle_infinite1:
shows "1 / sqrt(1 + (cmod b)⇧2) ≤ 1 / sqrt(1 + (cmod c)⇧2) + cmod (b - c) / (sqrt(1 + (cmod b)⇧2) * sqrt(1 + (cmod c)⇧2))"
proof-
let ?bb = "sqrt (1 + (cmod b)⇧2)" and ?cc = "sqrt (1 + (cmod c)⇧2)"
have "?bb > 0" "?cc > 0"
by (metis add_strict_increasing real_sqrt_gt_0_iff zero_le_power2 zero_less_one)+
hence *: "?bb * ?cc ≥ 0"
by simp
have **: "(?cc - ?bb) / (?bb * ?cc) = 1 / ?bb - 1 / ?cc"
using ‹sqrt (1 + (cmod b)⇧2) > 0› ‹sqrt (1 + (cmod c)⇧2) > 0›
by (simp add: field_simps)
show "1 / ?bb ≤ 1 / ?cc + cmod (b - c) / (?bb * ?cc)"
using divide_right_mono[OF cmod_diff_ge[of c b] *]
by (subst (asm) **) (simp add: field_simps norm_minus_commute)
qed
lemma dist_fs_triangle_infinite2:
shows "1 / sqrt(1 + (cmod a)⇧2) ≤ cmod (a - c) / (sqrt (1+(cmod a)⇧2) * sqrt (1+(cmod c)⇧2)) + 1 / sqrt(1 + (cmod c)⇧2)"
using dist_fs_triangle_infinite1[of a c]
by simp
lemma dist_fs_triangle_infinite3:
shows "cmod(a - b) / (sqrt (1+(cmod a)⇧2) * sqrt (1+(cmod b)⇧2)) ≤ 1 / sqrt(1 + (cmod a)⇧2) + 1 / sqrt(1 + (cmod b)⇧2)"
proof-
let ?aa = "sqrt (1 + (cmod a)⇧2)" and ?bb = "sqrt (1 + (cmod b)⇧2)"
have "?aa > 0" "?bb > 0"
by (metis add_strict_increasing real_sqrt_gt_0_iff zero_le_power2 zero_less_one)+
hence *: "?aa * ?bb ≥ 0"
by simp
have **: "(?aa + ?bb) / (?aa * ?bb) = 1 / ?aa + 1 / ?bb"
using ‹?aa > 0› ‹?bb > 0›
by (simp add: field_simps)
show "cmod (a - b) / (?aa * ?bb) ≤ 1 / ?aa + 1 / ?bb"
using divide_right_mono[OF cmod_diff_le[of a b] *]
by (subst (asm) **) (simp add: field_simps norm_minus_commute)
qed
lemma dist_fs_triangle:
shows "dist_fs A B ≤ dist_fs A C + dist_fs C B"
proof (cases "A = ∞⇩h")
case True
show ?thesis
proof (cases "B = ∞⇩h")
case True
show ?thesis
proof (cases "C = ∞⇩h")
case True
show ?thesis
using ‹A = ∞⇩h› ‹B = ∞⇩h› ‹C = ∞⇩h›
by simp
next
case False
then obtain c where "C = of_complex c"
using inf_or_of_complex[of C]
by auto
show ?thesis
using ‹A = ∞⇩h› ‹B = ∞⇩h› ‹C = of_complex c›
by (simp add: dist_fs_infinite2 dist_fs_sym)
qed
next
case False
then obtain b where "B = of_complex b"
using inf_or_of_complex[of B]
by auto
show ?thesis
proof (cases "C = ∞⇩h")
case True
show ?thesis
using ‹A = ∞⇩h› ‹C = ∞⇩h› ‹B = of_complex b›
by simp
next
case False
then obtain c where "C = of_complex c"
using inf_or_of_complex[of C]
by auto
show ?thesis
using ‹A = ∞⇩h› ‹B = of_complex b› ‹C = of_complex c›
using mult_left_mono[OF dist_fs_triangle_infinite1[of b c], of 2]
by (simp add: dist_fs_finite dist_fs_infinite1 dist_fs_infinite2 dist_fs_sym)
qed
qed
next
case False
then obtain a where "A = of_complex a"
using inf_or_of_complex[of A]
by auto
show ?thesis
proof (cases "B = ∞⇩h")
case True
show ?thesis
proof (cases "C = ∞⇩h")
case True
show ?thesis
using ‹B = ∞⇩h› ‹C = ∞⇩h› ‹A = of_complex a›
by (simp add: dist_fs_infinite2)
next
case False
then obtain c where "C = of_complex c"
using inf_or_of_complex[of C]
by auto
show ?thesis
using ‹B = ∞⇩h› ‹C = of_complex c› ‹A = of_complex a›
using mult_left_mono[OF dist_fs_triangle_infinite2[of a c], of 2]
by (simp add: dist_fs_finite dist_fs_infinite1 dist_fs_infinite2)
qed
next
case False
then obtain b where "B = of_complex b"
using inf_or_of_complex[of B]
by auto
show ?thesis
proof (cases "C = ∞⇩h")
case True
thus ?thesis
using ‹C = ∞⇩h› ‹B = of_complex b› ‹A = of_complex a›
using mult_left_mono[OF dist_fs_triangle_infinite3[of a b], of 2]
by (simp add: dist_fs_finite dist_fs_infinite1 dist_fs_infinite2)
next
case False
then obtain c where "C = of_complex c"
using inf_or_of_complex[of C]
by auto
show ?thesis
using ‹A = of_complex a› ‹B = of_complex b› ‹C = of_complex c›
using mult_left_mono[OF dist_fs_triangle_finite[of a b c], of 2]
by (simp add: dist_fs_finite norm_minus_commute dist_fs_sym)
qed
qed
qed
subsubsection ‹$\mathbb{C}P^1$ with Fubini-Study metric is a metric space›
text ‹Using the (already available) fact that $\mathbb{R}^3$ is a metric space (under the distance
function $\lambda\ x\ y.\ @{term norm}(x - y)$), it was not difficult to show that the type @{term
complex_homo} equipped with @{term dist_fs} is a metric space, i.e., an instantiation of the @{term
metric_space} locale.›
instantiation complex_homo :: metric_space
begin
definition "dist_complex_homo = dist_fs"
definition "(uniformity_complex_homo :: (complex_homo × complex_homo) filter) = (INF e∈{0<..}. principal {(x, y). dist_class.dist x y < e})"
definition "open_complex_homo (U :: complex_homo set) = (∀ x ∈ U. eventually (λ(x', y). x' = x ⟶ y ∈ U) uniformity)"
instance
proof
fix x y :: complex_homo
show "(dist_class.dist x y = 0) = (x = y)"
unfolding dist_complex_homo_def
using dist_fs_zero1[of x] dist_fs_zero2[of x y]
by auto
next
fix x y z :: complex_homo
show "dist_class.dist x y ≤ dist_class.dist x z + dist_class.dist y z"
unfolding dist_complex_homo_def
using dist_fs_triangle[of x y z]
by (simp add: dist_fs_sym)
qed (simp_all add: open_complex_homo_def uniformity_complex_homo_def)
end
subsubsection ‹Chordal distance on the Riemann sphere›
text ‹Distance of the two points is given by the length of the chord. We show that it corresponds to
the Fubini-Study metric in the plane.›
definition dist_riemann_sphere_r3 :: "R3 ⇒ R3 ⇒ real" where [simp]:
"dist_riemann_sphere_r3 M1 M2 =
(let (x1, y1, z1) = M1;
(x2, y2, z2) = M2
in norm (x1 - x2, y1 - y2, z1 - z2))"
lemma dist_riemann_sphere_r3_inner:
assumes "M1 ∈ unit_sphere" and "M2 ∈ unit_sphere"
shows "(dist_riemann_sphere_r3 M1 M2)⇧2 = 2 - 2 * inner M1 M2"
using assms
apply (cases M1, cases M2)
apply (auto simp add: norm_prod_def)
apply (simp add: power2_eq_square field_simps)
done
lift_definition dist_riemann_sphere' :: "riemann_sphere ⇒ riemann_sphere ⇒ real" is dist_riemann_sphere_r3
done
lemma dist_riemann_sphere_ge_0 [simp]:
shows "dist_riemann_sphere' M1 M2 ≥ 0"
apply transfer
using norm_ge_zero
by (simp add: split_def Let_def)
text ‹Using stereographic projection we prove the connection between chordal metric on the spehere
and Fubini-Study metric in the plane.›
lemma dist_stereographic_finite:
assumes "stereographic M1 = of_complex m1" and "stereographic M2 = of_complex m2"
shows "dist_riemann_sphere' M1 M2 = 2 * cmod (m1 - m2) / (sqrt (1 + (cmod m1)⇧2) * sqrt (1 + (cmod m2)⇧2))"
using assms
proof-
have *: "M1 = inv_stereographic (of_complex m1)" "M2 = inv_stereographic (of_complex m2)"
using inv_stereographic_is_inv assms
by (metis inv_stereographic_stereographic)+
have "(1 + (cmod m1)⇧2) ≠ 0" "(1 + (cmod m2)⇧2) ≠ 0"
by (smt power2_less_0)+
have "(1 + (cmod m1)⇧2) > 0" "(1 + (cmod m2)⇧2) > 0"
by (smt realpow_square_minus_le)+
hence "(1 + (cmod m1)⇧2) * (1 + (cmod m2)⇧2) > 0"
by (metis norm_mult_less norm_zero power2_eq_square zero_power2)
hence ++: "sqrt ((1 + cmod m1 * cmod m1) * (1 + cmod m2 * cmod m2)) > 0"
using real_sqrt_gt_0_iff
by (simp add: power2_eq_square)
hence **: "(2 * cmod (m1 - m2) / sqrt ((1 + cmod m1 * cmod m1) * (1 + cmod m2 * cmod m2))) ≥ 0 ⟷ cmod (m1 - m2) ≥ 0"
by (metis diff_self divide_nonneg_pos mult_2 norm_ge_zero norm_triangle_ineq4 norm_zero)
have "(dist_riemann_sphere' M1 M2)⇧2 * (1 + (cmod m1)⇧2) * (1 + (cmod m2)⇧2) = 4 * (cmod (m1 - m2))⇧2"
using *
proof (transfer, transfer)
fix m1 m2 M1 M2
assume us: "M1 ∈ unit_sphere" "M2 ∈ unit_sphere" and
*: "M1 = inv_stereographic_cvec_r3 (of_complex_cvec m1)" "M2 = inv_stereographic_cvec_r3 (of_complex_cvec m2)"
have "(1 + (cmod m1)⇧2) ≠ 0" "(1 + (cmod m2)⇧2) ≠ 0"
by (smt power2_less_0)+
thus "(dist_riemann_sphere_r3 M1 M2)⇧2 * (1 + (cmod m1)⇧2) * (1 + (cmod m2)⇧2) =
4 * (cmod (m1 - m2))⇧2"
apply (subst dist_riemann_sphere_r3_inner[OF us])
apply (subst *)+
apply (simp add: dist_riemann_sphere_r3_inner[OF us] complex_mult_cnj_cmod)
apply (subst left_diff_distrib[of 2])
apply (subst left_diff_distrib[of "2*(1+(cmod m1)⇧2)"])
apply (subst distrib_right[of _ _ "(1 + (cmod m1)⇧2)"])
apply (subst distrib_right[of _ _ "(1 + (cmod m1)⇧2)"])
apply simp
apply (subst distrib_right[of _ _ "(1 + (cmod m2)⇧2)"])
apply (subst distrib_right[of _ _ "(1 + (cmod m2)⇧2)"])
apply (subst distrib_right[of _ _ "(1 + (cmod m2)⇧2)"])
apply simp
apply (subst (asm) cmod_square)+
apply (subst cmod_square)+
apply (simp add: field_simps)
done
qed
hence "(dist_riemann_sphere' M1 M2)⇧2 = 4 * (cmod (m1 - m2))⇧2 / ((1 + (cmod m1)⇧2) * (1 + (cmod m2)⇧2))"
using ‹(1 + (cmod m1)⇧2) ≠ 0› ‹(1 + (cmod m2)⇧2) ≠ 0›
using eq_divide_imp[of "(1 + (cmod m1)⇧2) * (1 + (cmod m2)⇧2)" "(dist_riemann_sphere' M1 M2)⇧2" "4 * (cmod (m1 - m2))⇧2"]
by simp
thus "dist_riemann_sphere' M1 M2 = 2 * cmod (m1 - m2) / (sqrt (1 + (cmod m1)⇧2) * sqrt (1 + (cmod m2)⇧2))"
using power2_eq_iff[of "dist_riemann_sphere' M1 M2" "2 * (cmod (m1 - m2)) / sqrt ((1 + (cmod m1)⇧2) * (1 + (cmod m2)⇧2))"]
using ‹(1 + (cmod m1)⇧2) * (1 + (cmod m2)⇧2) > 0› ‹(1 + (cmod m1)⇧2) > 0› ‹(1 + (cmod m2)⇧2) > 0›
apply (auto simp add: power2_eq_square real_sqrt_mult[symmetric])
using dist_riemann_sphere_ge_0[of M1 M2] **
using ++ divide_le_0_iff by force
qed
lemma dist_stereographic_infinite:
assumes "stereographic M1 = ∞⇩h" and "stereographic M2 = of_complex m2"
shows "dist_riemann_sphere' M1 M2 = 2 / sqrt (1 + (cmod m2)⇧2)"
proof-
have *: "M1 = inv_stereographic ∞⇩h" "M2 = inv_stereographic (of_complex m2)"
using inv_stereographic_is_inv assms
by (metis inv_stereographic_stereographic)+
have "(1 + (cmod m2)⇧2) ≠ 0"
by (smt power2_less_0)
have "(1 + (cmod m2)⇧2) > 0"
by (smt realpow_square_minus_le)+
hence "sqrt (1 + cmod m2 * cmod m2) > 0"
using real_sqrt_gt_0_iff
by (simp add: power2_eq_square)
hence **: "2 / sqrt (1 + cmod m2 * cmod m2) > 0"
by simp
have "(dist_riemann_sphere' M1 M2)⇧2 * (1 + (cmod m2)⇧2) = 4"
using *
apply transfer
apply transfer
proof-
fix M1 M2 m2
assume us: "M1 ∈ unit_sphere" "M2 ∈ unit_sphere" and
*: "M1 = inv_stereographic_cvec_r3 ∞⇩v" "M2 = inv_stereographic_cvec_r3 (of_complex_cvec m2)"
have "(1 + (cmod m2)⇧2) ≠ 0"
by (smt power2_less_0)
thus "(dist_riemann_sphere_r3 M1 M2)⇧2 * (1 + (cmod m2)⇧2) = 4"
apply (subst dist_riemann_sphere_r3_inner[OF us])
apply (subst *)+
apply (simp add: complex_mult_cnj_cmod)
apply (subst left_diff_distrib[of 2], simp)
done
qed
hence "(dist_riemann_sphere' M1 M2)⇧2 = 4 / (1 + (cmod m2)⇧2)"
using ‹(1 + (cmod m2)⇧2) ≠ 0›
by (simp add: field_simps)
thus "dist_riemann_sphere' M1 M2 = 2 / sqrt (1 + (cmod m2)⇧2)"
using power2_eq_iff[of "dist_riemann_sphere' M1 M2" "2 / sqrt (1 + (cmod m2)⇧2)"]
using ‹(1 + (cmod m2)⇧2) > 0›
apply (auto simp add: power2_eq_square real_sqrt_mult[symmetric])
using dist_riemann_sphere_ge_0[of M1 M2] **
by simp
qed
lemma dist_rieman_sphere_zero [simp]:
shows "dist_riemann_sphere' M M = 0"
by transfer auto
lemma dist_riemann_sphere_sym:
shows "dist_riemann_sphere' M1 M2 = dist_riemann_sphere' M2 M1"
proof transfer
fix M1 M2 :: R3
obtain x1 y1 z1 x2 y2 z2 where MM: "(x1, y1, z1) = M1" "(x2, y2, z2) = M2"
by (cases "M1", cases "M2", auto)
show "dist_riemann_sphere_r3 M1 M2 = dist_riemann_sphere_r3 M2 M1"
using norm_minus_cancel[of "(x1 - x2, y1 - y2, z1 - z2)"] MM[symmetric]
by simp
qed
text ‹Central theorem that connects the two metrics.›
lemma dist_stereographic:
shows "dist_riemann_sphere' M1 M2 = dist_fs (stereographic M1) (stereographic M2)"
proof (cases "M1 = North")
case True
hence "stereographic M1 = ∞⇩h"
by (simp add: stereographic_North)
show ?thesis
proof (cases "M2 = North")
case True
show ?thesis
using ‹M1 = North› ‹M2 = North›
by auto
next
case False
hence "stereographic M2 ≠ ∞⇩h"
using stereographic_North[of M2]
by simp
then obtain m2 where "stereographic M2 = of_complex m2"
using inf_or_of_complex[of "stereographic M2"]
by auto
show ?thesis
using ‹stereographic M2 = of_complex m2› ‹stereographic M1 = ∞⇩h›
using dist_fs_infinite1 dist_stereographic_infinite
by (simp add: dist_fs_sym)
qed
next
case False
hence "stereographic M1 ≠ ∞⇩h"
by (simp add: stereographic_North)
then obtain m1 where "stereographic M1 = of_complex m1"
using inf_or_of_complex[of "stereographic M1"]
by auto
show ?thesis
proof (cases "M2 = North")
case True
hence "stereographic M2 = ∞⇩h"
by (simp add: stereographic_North)
show ?thesis
using ‹stereographic M1 = of_complex m1› ‹stereographic M2 = ∞⇩h›
using dist_fs_infinite2 dist_stereographic_infinite
by (subst dist_riemann_sphere_sym, simp add: dist_fs_sym)
next
case False
hence "stereographic M2 ≠ ∞⇩h"
by (simp add: stereographic_North)
then obtain m2 where "stereographic M2 = of_complex m2"
using inf_or_of_complex[of "stereographic M2"]
by auto
show ?thesis
using ‹stereographic M1 = of_complex m1› ‹stereographic M2 = of_complex m2›
using dist_fs_finite dist_stereographic_finite
by simp
qed
qed
text ‹Other direction›
lemma dist_stereographic':
shows "dist_fs A B = dist_riemann_sphere' (inv_stereographic A) (inv_stereographic B)"
by (subst dist_stereographic) (metis stereographic_inv_stereographic)
text ‹The @{term riemann_sphere} equipped with @{term dist_riemann_sphere'} is a metric space, i.e.,
an instantiation of the @{term metric_space} locale.›
instantiation riemann_sphere :: metric_space
begin
definition "dist_riemann_sphere = dist_riemann_sphere'"
definition "(uniformity_riemann_sphere :: (riemann_sphere × riemann_sphere) filter) = (INF e∈{0<..}. principal {(x, y). dist_class.dist x y < e})"
definition "open_riemann_sphere (U :: riemann_sphere set) = (∀ x ∈ U. eventually (λ(x', y). x' = x ⟶ y ∈ U) uniformity)"
instance
proof
fix x y :: riemann_sphere
show "(dist_class.dist x y = 0) = (x = y)"
unfolding dist_riemann_sphere_def
proof transfer
fix x y :: R3
obtain x1 y1 z1 x2 y2 z2 where *: "(x1, y1, z1) = x" "(x2, y2, z2) = y"
by (cases x, cases y, auto)
assume "x ∈ unit_sphere" "y ∈ unit_sphere"
thus "(dist_riemann_sphere_r3 x y = 0) = (x = y)"
using norm_eq_zero[of "(x1 - y2, y1 - y2, z1 - z2)"] using *[symmetric]
by (simp add: zero_prod_def)
qed
next
fix x y z :: riemann_sphere
show "dist_class.dist x y ≤ dist_class.dist x z + dist_class.dist y z"
unfolding dist_riemann_sphere_def
proof transfer
fix x y z :: R3
obtain x1 y1 z1 x2 y2 z2 x3 y3 z3 where MM: "(x1, y1, z1) = x" "(x2, y2, z2) = y" "(x3, y3, z3) = z"
by (cases "x", cases "y", cases "z", auto)
assume "x ∈ unit_sphere" "y ∈ unit_sphere" "z ∈ unit_sphere"
thus "dist_riemann_sphere_r3 x y ≤ dist_riemann_sphere_r3 x z + dist_riemann_sphere_r3 y z"
using MM[symmetric] norm_minus_cancel[of "(x3 - x2, y3 - y2, z3 - z2)"] norm_triangle_ineq[of "(x1 - x3, y1 - y3, z1 - z3)" "(x3 - x2, y3 - y2, z3 - z2)"]
by simp
qed
qed (simp_all add: uniformity_riemann_sphere_def open_riemann_sphere_def)
end
text ‹The @{term riemann_sphere} metric space is perfect, i.e., it does not have isolated points.›
instantiation riemann_sphere :: perfect_space
begin
instance proof
fix M :: riemann_sphere
show "¬ open {M}"
unfolding open_dist dist_riemann_sphere_def
apply (subst dist_riemann_sphere_sym)
proof transfer
fix M
assume "M ∈ unit_sphere"
obtain x y z where MM: "M = (x, y, z)"
by (cases "M") auto
then obtain α β where *: "x = cos α * cos β" "y = cos α * sin β" "z = sin α" "-pi / 2 ≤ α ∧ α ≤ pi / 2"
using ‹M ∈ unit_sphere›
using ex_sphere_params[of x y z]
by auto
have "⋀ e. e > 0 ⟹ (∃y. y ∈ unit_sphere ∧ dist_riemann_sphere_r3 M y < e ∧ y ≠ M)"
proof-
fix e :: real
assume "e > 0"
then obtain α' where "1 - (e*e/2) < cos (α - α')" "α ≠ α'" "-pi/2 ≤ α'" "α' ≤ pi/2"
using ex_cos_gt[of α "1 - (e*e/2)"] ‹- pi / 2 ≤ α ∧ α ≤ pi / 2›
by auto
hence "sin α ≠ sin α'"
using ‹-pi / 2 ≤ α ∧ α ≤ pi / 2› sin_inj[of α α']
by auto
have "2 - 2 * cos (α - α') < e*e"
using mult_strict_right_mono[OF ‹1 - (e*e/2) < cos (α - α')›, of 2]
by (simp add: field_simps)
have "2 - 2 * cos (α - α') ≥ 0"
using cos_le_one[of "α - α'"]
by (simp add: algebra_split_simps)
let ?M' = "(cos α' * cos β, cos α' * sin β, sin α')"
have "dist_riemann_sphere_r3 M ?M' = sqrt ((cos α - cos α')⇧2 + (sin α - sin α')⇧2)"
using MM * sphere_params_on_sphere[of _ α' β]
using sin_cos_squared_add[of β]
apply (simp add: dist_riemann_sphere'_def Abs_riemann_sphere_inverse norm_prod_def)
apply (subst left_diff_distrib[symmetric])+
apply (subst power_mult_distrib)+
apply (subst distrib_left[symmetric])
apply simp
done
also have "... = sqrt (2 - 2*cos (α - α'))"
by (simp add: power2_eq_square field_simps cos_diff)
finally
have "(dist_riemann_sphere_r3 M ?M')⇧2 = 2 - 2*cos (α - α')"
using ‹2 - 2 * cos (α - α') ≥ 0›
by simp
hence "(dist_riemann_sphere_r3 M ?M')⇧2 < e⇧2"
using ‹2 - 2 * cos (α - α') < e*e›
by (simp add: power2_eq_square)
hence "dist_riemann_sphere_r3 M ?M' < e"
apply (rule power2_less_imp_less)
using ‹e > 0›
by simp
moreover
have "M ≠ ?M'"
using MM ‹sin α ≠ sin α'› *
by simp
moreover
have "?M' ∈ unit_sphere"
using sphere_params_on_sphere by auto
ultimately
show "∃y. y ∈ unit_sphere ∧ dist_riemann_sphere_r3 M y < e ∧ y ≠ M"
unfolding dist_riemann_sphere_def
by (rule_tac x="?M'" in exI, simp)
qed
thus "¬ (∀x∈{M}. ∃e>0. ∀y∈{x. x ∈ unit_sphere}. dist_riemann_sphere_r3 x y < e ⟶ y ∈ {M})"
by auto
qed
qed
end
text ‹The @{term complex_homo} metric space is perfect, i.e., it does not have isolated points.›
instantiation complex_homo :: perfect_space
begin
instance proof
fix x::complex_homo
show "¬ open {x}"
unfolding open_dist
proof (auto)
fix e::real
assume "e > 0"
thus "∃ y. dist_class.dist y x < e ∧ y ≠ x"
using not_open_singleton[of "inv_stereographic x"]
unfolding open_dist
unfolding dist_complex_homo_def dist_riemann_sphere_def
apply (subst dist_stereographic', auto)
apply (erule_tac x=e in allE, auto)
apply (rule_tac x="stereographic y" in exI, auto)
done
qed
qed
end
lemma Lim_within:
shows "(f ⤏ l) (at a within S) ⟷
(∀e >0. ∃d>0. ∀x ∈ S. 0 < dist_class.dist x a ∧ dist_class.dist x a < d ⟶ dist_class.dist (f x) l < e)"
by (auto simp: tendsto_iff eventually_at)
lemma continuous_on_iff:
shows "continuous_on s f ⟷
(∀x∈s. ∀e>0. ∃d>0. ∀x'∈s. dist_class.dist x' x < d ⟶ dist_class.dist (f x') (f x) < e)"
unfolding continuous_on_def Lim_within
by (metis dist_pos_lt dist_self)
text ‹Using the chordal metric in the extended plane, and the Euclidean metric on the sphere in
$\mathbb{R}^3$, the stereographic and inverse stereographic projections are proved to be
continuous.›
lemma "continuous_on UNIV stereographic"
unfolding continuous_on_iff
unfolding dist_complex_homo_def dist_riemann_sphere_def
by (subst dist_stereographic', auto)
lemma "continuous_on UNIV inv_stereographic"
unfolding continuous_on_iff
unfolding dist_complex_homo_def dist_riemann_sphere_def
by (subst dist_stereographic, auto)
subsubsection ‹Chordal circles›
text ‹Real circlines are sets of points that are equidistant from some given point in the chordal
metric. There are exactly two such points (two chordal centers). On the Riemann sphere, these two
points are obtained as intersections of the sphere and a line that goes trough center of the circle,
and its orthogonal to its plane.›
text ‹The circline for the given chordal center and radius.›
definition chordal_circle_cvec_cmat :: "complex_vec ⇒ real ⇒ complex_mat" where
[simp]: "chordal_circle_cvec_cmat a r =
(let (a1, a2) = a
in ((4*a2*cnj a2 - (cor r)⇧2*(a1*cnj a1 + a2*cnj a2)), (-4*a1*cnj a2), (-4*cnj a1*a2), (4*a1*cnj a1 - (cor r)⇧2*(a1*cnj a1 + a2*cnj a2))))"
lemma chordal_circle_cmat_hermitean_nonzero [simp]:
assumes "a ≠ vec_zero"
shows "chordal_circle_cvec_cmat a r ∈ hermitean_nonzero"
using assms
by (cases a) (auto simp add: hermitean_def mat_adj_def mat_cnj_def Let_def)
lift_definition chordal_circle_hcoords_clmat :: "complex_homo_coords ⇒ real ⇒ circline_mat" is chordal_circle_cvec_cmat
using chordal_circle_cmat_hermitean_nonzero
by (simp del: chordal_circle_cvec_cmat_def)
lift_definition chordal_circle :: "complex_homo ⇒ real ⇒ circline" is chordal_circle_hcoords_clmat
proof transfer
fix a b :: complex_vec and r :: real
assume *: "a ≠ vec_zero" "b ≠ vec_zero"
obtain a1 a2 where aa: "a = (a1, a2)"
by (cases a, auto)
obtain b1 b2 where bb: "b = (b1, b2)"
by (cases b, auto)
assume "a ≈⇩v b"
then obtain k where "b = (k * a1, k * a2)" "k ≠ 0"
using aa bb
by auto
moreover
have "cor (Re (k * cnj k)) = k * cnj k"
by (metis complex_In_mult_cnj_zero complex_of_real_Re)
ultimately
show "circline_eq_cmat (chordal_circle_cvec_cmat a r) (chordal_circle_cvec_cmat b r)"
using * aa bb
by simp (rule_tac x="Re (k*cnj k)" in exI, auto simp add: Let_def field_simps)
qed
lemma sqrt_1_plus_square:
shows "sqrt (1 + a⇧2) ≠ 0"
by (smt real_sqrt_less_mono real_sqrt_zero realpow_square_minus_le)
lemma
assumes "dist_fs z a = r"
shows "z ∈ circline_set (chordal_circle a r)"
proof (cases "a ≠ ∞⇩h")
case True
then obtain a' where "a = of_complex a'"
using inf_or_of_complex
by auto
let ?A = "4 - (cor r)⇧2 * (1 + (a'*cnj a'))" and ?B = "-4*a'" and ?C="-4*cnj a'" and ?D = "4*a'*cnj a' - (cor r)⇧2 * (1 + (a'*cnj a'))"
have hh: "(?A, ?B, ?C, ?D) ∈ {H. hermitean H ∧ H ≠ mat_zero}"
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
hence *: "chordal_circle (of_complex a') r = mk_circline ?A ?B ?C ?D"
by (transfer, transfer, simp, rule_tac x=1 in exI, simp)
show ?thesis
proof (cases "z ≠ ∞⇩h")
case True
then obtain z' where "z = of_complex z'"
using inf_or_of_complex[of z] inf_or_of_complex[of a]
by auto
have "2 * cmod (z' - a') / (sqrt (1 + (cmod z')⇧2) * sqrt (1 + (cmod a')⇧2)) = r"
using dist_fs_finite[of z' a'] assms ‹z = of_complex z'› ‹a = of_complex a'›
by auto
hence "4 * (cmod (z' - a'))⇧2 / ((1 + (cmod z')⇧2) * (1 + (cmod a')⇧2)) = r⇧2 "
by (auto simp add: field_simps)
moreover
have "sqrt (1 + (cmod z')⇧2) ≠ 0" "sqrt (1 + (cmod a')⇧2) ≠ 0"
using sqrt_1_plus_square
by simp+
hence "(1 + (cmod z')⇧2) * (1 + (cmod a')⇧2) ≠ 0"
by simp
ultimately
have "4 * (cmod (z' - a'))⇧2 = r⇧2 * ((1 + (cmod z')⇧2) * (1 + (cmod a')⇧2))"
by (simp add: field_simps)
hence "4 * Re ((z' - a')*cnj (z' - a')) = r⇧2 * (1 + Re (z'*cnj z')) * (1 + Re (a'*cnj a'))"
by ((subst cmod_square[symmetric])+, simp)
hence "4 * (Re(z'*cnj z') - Re(a'*cnj z') - Re(cnj a'*z') + Re(a'*cnj a')) = r⇧2 * (1 + Re (z'*cnj z')) * (1 + Re (a'*cnj a'))"
by (simp add: field_simps)
hence "Re (?A * z' * cnj z' + ?B * cnj z' + ?C * z' + ?D) = 0"
by (simp add: power2_eq_square field_simps)
hence "?A * z' * cnj z' + ?B * cnj z' + ?C * z' + ?D = 0"
by (subst complex_eq_if_Re_eq) (auto simp add: power2_eq_square)
hence "(cnj z' * ?A + ?C) * z' + (cnj z' * ?B + ?D) = 0"
by algebra
hence "z ∈ circline_set (mk_circline ?A ?B ?C ?D)"
using ‹z = of_complex z'› hh
unfolding circline_set_def
by simp (transfer, transfer, simp add: vec_cnj_def)
thus ?thesis
using *
by (subst ‹a = of_complex a'›) simp
next
case False
hence "2 / sqrt (1 + (cmod a')⇧2) = r"
using assms ‹a = of_complex a'›
using dist_fs_infinite2[of a']
by simp
moreover
have "sqrt (1 + (cmod a')⇧2) ≠ 0"
using sqrt_1_plus_square
by simp
ultimately
have "2 = r * sqrt (1 + (cmod a')⇧2)"
by (simp add: field_simps)
hence "4 = (r * sqrt (1 + (cmod a')⇧2))⇧2"
by simp
hence "4 = r⇧2 * (1 + (cmod a')⇧2)"
by (simp add: power_mult_distrib)
hence "Re (4 - (cor r)⇧2 * (1 + (a' * cnj a'))) = 0"
by (subst (asm) cmod_square) (simp add: field_simps power2_eq_square)
hence "4 - (cor r)⇧2 * (1 + (a'*cnj a')) = 0"
by (subst complex_eq_if_Re_eq) (auto simp add: power2_eq_square)
hence "circline_A0 (mk_circline ?A ?B ?C ?D)"
using hh
by (simp, transfer, transfer, simp)
hence "z ∈ circline_set (mk_circline ?A ?B ?C ?D)"
using inf_in_circline_set[of "mk_circline ?A ?B ?C ?D"]
using ‹¬ z ≠ ∞⇩h›
by simp
thus ?thesis
using *
by (subst ‹a = of_complex a'›) simp
qed
next
case False
let ?A = "-(cor r)⇧2" and ?B = "0" and ?C = "0" and ?D = "4 -(cor r)⇧2"
have hh: "(?A, ?B, ?C, ?D) ∈ {H. hermitean H ∧ H ≠ mat_zero}"
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
hence *: "chordal_circle a r = mk_circline ?A ?B ?C ?D"
using ‹¬ a ≠ ∞⇩h›
by simp (transfer, transfer, simp, rule_tac x=1 in exI, simp)
show ?thesis
proof (cases "z = ∞⇩h")
case True
show ?thesis
using assms ‹z = ∞⇩h› ‹¬ a ≠ ∞⇩h›
using * hh
by (simp, subst inf_in_circline_set, transfer, transfer, simp)
next
case False
then obtain z' where "z = of_complex z'"
using inf_or_of_complex[of z]
by auto
have "2 / sqrt (1 + (cmod z')⇧2) = r"
using assms ‹z = of_complex z'›‹¬ a ≠ ∞⇩h›
using dist_fs_infinite2[of z']
by (simp add: dist_fs_sym)
moreover
have "sqrt (1 + (cmod z')⇧2) ≠ 0"
using sqrt_1_plus_square
by simp
ultimately
have "2 = r * sqrt (1 + (cmod z')⇧2)"
by (simp add: field_simps)
hence "4 = (r * sqrt (1 + (cmod z')⇧2))⇧2"
by simp
hence "4 = r⇧2 * (1 + (cmod z')⇧2)"
by (simp add: power_mult_distrib)
hence "Re (4 - (cor r)⇧2 * (1 + (z' * cnj z'))) = 0"
by (subst (asm) cmod_square) (simp add: field_simps power2_eq_square)
hence "- (cor r)⇧2 * z'*cnj z' + 4 - (cor r)⇧2 = 0"
by (subst complex_eq_if_Re_eq) (auto simp add: power2_eq_square field_simps)
hence "z ∈ circline_set (mk_circline ?A ?B ?C ?D)"
using hh
unfolding circline_set_def
by (subst ‹z = of_complex z'›, simp) (transfer, transfer, auto simp add: vec_cnj_def field_simps)
thus ?thesis
using *
by simp
qed
qed
lemma
assumes "z ∈ circline_set (chordal_circle a r)" and "r ≥ 0"
shows "dist_fs z a = r"
proof (cases "a = ∞⇩h")
case False
then obtain a' where "a = of_complex a'"
using inf_or_of_complex
by auto
let ?A = "4 - (cor r)⇧2 * (1 + (a'*cnj a'))" and ?B = "-4*a'" and ?C="-4*cnj a'" and ?D = "4*a'*cnj a' - (cor r)⇧2 * (1 + (a'*cnj a'))"
have hh: "(?A, ?B, ?C, ?D) ∈ {H. hermitean H ∧ H ≠ mat_zero}"
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
hence *: "chordal_circle (of_complex a') r = mk_circline ?A ?B ?C ?D"
by (transfer, transfer, simp, rule_tac x=1 in exI, simp)
show ?thesis
proof (cases "z = ∞⇩h")
case False
then obtain z' where "z = of_complex z'"
using inf_or_of_complex[of z] inf_or_of_complex[of a]
by auto
hence "z ∈ circline_set (mk_circline ?A ?B ?C ?D)"
using assms ‹a = of_complex a'› *
by simp
hence "(cnj z' * ?A + ?C) * z' + (cnj z' * ?B + ?D) = 0"
using hh
unfolding circline_set_def
by (subst (asm) ‹z = of_complex z'›, simp) (transfer, transfer, simp add: vec_cnj_def)
hence "?A * z' * cnj z' + ?B * cnj z' + ?C * z' + ?D = 0"
by algebra
hence "Re (?A * z' * cnj z' + ?B * cnj z' +?C * z' +?D) = 0"
by (simp add: power2_eq_square field_simps)
hence "4 * Re ((z' - a')*cnj (z' - a')) = r⇧2 * (1 + Re (z'*cnj z')) * (1 + Re (a'*cnj a'))"
by (simp add: field_simps power2_eq_square)
hence "4 * (cmod (z' - a'))⇧2 = r⇧2 * ((1 + (cmod z')⇧2) * (1 + (cmod a')⇧2))"
by (subst cmod_square)+ simp
moreover
have "sqrt (1 + (cmod z')⇧2) ≠ 0" "sqrt (1 + (cmod a')⇧2) ≠ 0"
using sqrt_1_plus_square
by simp+
hence "(1 + (cmod z')⇧2) * (1 + (cmod a')⇧2) ≠ 0"
by simp
ultimately
have "4 * (cmod (z' - a'))⇧2 / ((1 + (cmod z')⇧2) * (1 + (cmod a')⇧2)) = r⇧2 "
by (simp add: field_simps)
hence "2 * cmod (z' - a') / (sqrt (1 + (cmod z')⇧2) * sqrt (1 + (cmod a')⇧2)) = r"
using ‹r ≥ 0›
by (subst (asm) real_sqrt_eq_iff[symmetric]) (simp add: real_sqrt_mult real_sqrt_divide)
thus ?thesis
using ‹z = of_complex z'› ‹a = of_complex a'›
using dist_fs_finite[of z' a']
by simp
next
case True
have "z ∈ circline_set (mk_circline ?A ?B ?C ?D)"
using assms ‹a = of_complex a'› *
by simp
hence "circline_A0 (mk_circline ?A ?B ?C ?D)"
using inf_in_circline_set[of "mk_circline ?A ?B ?C ?D"]
using ‹z = ∞⇩h›
by simp
hence "4 - (cor r)⇧2 * (1 + (a'*cnj a')) = 0"
using hh
by (transfer, transfer, simp)
hence "Re (4 - (cor r)⇧2 * (1 + (a' * cnj a'))) = 0"
by simp
hence "4 = r⇧2 * (1 + (cmod a')⇧2)"
by (subst cmod_square) (simp add: power2_eq_square)
hence "2 = r * sqrt (1 + (cmod a')⇧2)"
using ‹r ≥ 0›
by (subst (asm) real_sqrt_eq_iff[symmetric]) (simp add: real_sqrt_mult)
moreover
have "sqrt (1 + (cmod a')⇧2) ≠ 0"
using sqrt_1_plus_square
by simp
ultimately
have "2 / sqrt (1 + (cmod a')⇧2) = r"
by (simp add: field_simps)
thus ?thesis
using ‹a = of_complex a'› ‹z = ∞⇩h›
using dist_fs_infinite2[of a']
by simp
qed
next
case True
let ?A = "-(cor r)⇧2" and ?B = "0" and ?C = "0" and ?D = "4 -(cor r)⇧2"
have hh: "(?A, ?B, ?C, ?D) ∈ {H. hermitean H ∧ H ≠ mat_zero}"
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
hence *: "chordal_circle a r = mk_circline ?A ?B ?C ?D"
using ‹a = ∞⇩h›
by simp (transfer, transfer, simp, rule_tac x=1 in exI, simp)
show ?thesis
proof (cases "z = ∞⇩h")
case True
thus ?thesis
using ‹a = ∞⇩h› assms * hh
by simp (subst (asm) inf_in_circline_set, transfer, transfer, simp)
next
case False
then obtain z' where "z = of_complex z'"
using inf_or_of_complex
by auto
hence "z ∈ circline_set (mk_circline ?A ?B ?C ?D)"
using assms *
by simp
hence "- (cor r)⇧2 * z'*cnj z' + 4 - (cor r)⇧2 = 0"
using hh
unfolding circline_set_def
apply (subst (asm) ‹z = of_complex z'›)
by (simp, transfer, transfer, simp add: vec_cnj_def, algebra)
hence "4 - (cor r)⇧2 * (1 + (z'*cnj z')) = 0"
by (simp add: field_simps)
hence "Re (4 - (cor r)⇧2 * (1 + (z' * cnj z'))) = 0"
by simp
hence "4 = r⇧2 * (1 + (cmod z')⇧2)"
by (subst cmod_square) (simp add: power2_eq_square)
hence "2 = r * sqrt (1 + (cmod z')⇧2)"
using ‹r ≥ 0›
by (subst (asm) real_sqrt_eq_iff[symmetric]) (simp add: real_sqrt_mult)
moreover
have "sqrt (1 + (cmod z')⇧2) ≠ 0"
using sqrt_1_plus_square
by simp
ultimately
have "2 / sqrt (1 + (cmod z')⇧2) = r"
by (simp add: field_simps)
thus ?thesis
using ‹z = of_complex z'› ‹a = ∞⇩h›
using dist_fs_infinite2[of z']
by (simp add: dist_fs_sym)
qed
qed
text ‹Two chordal centers and radii for the given circline›
definition chordal_circles_cmat :: "complex_mat ⇒ (complex × real) × (complex × real)" where
[simp]: "chordal_circles_cmat H =
(let (A, B, C, D) = H;
dsc = sqrt(Re ((D-A)⇧2 + 4 * (B*cnj B)));
a1 = (A - D + cor dsc) / (2 * C);
r1 = sqrt((4 - Re((-4 * a1/B) * A)) / (1 + Re (a1*cnj a1)));
a2 = (A - D - cor dsc) / (2 * C);
r2 = sqrt((4 - Re((-4 * a2/B) * A)) / (1 + Re (a2*cnj a2)))
in ((a1, r1), (a2, r2)))"
lift_definition chordal_circles_clmat :: "circline_mat ⇒ (complex × real) × (complex × real)" is chordal_circles_cmat
done
lift_definition chordal_circles :: "ocircline ⇒ (complex × real) × (complex × real)" is chordal_circles_clmat
proof transfer
fix H1 H2 :: complex_mat
obtain A1 B1 C1 D1 where hh1: "(A1, B1, C1, D1) = H1"
by (cases H1) auto
obtain A2 B2 C2 D2 where hh2: "(A2, B2, C2, D2) = H2"
by (cases H2) auto
assume "ocircline_eq_cmat H1 H2"
then obtain k where *: "k > 0" "A2 = cor k * A1" "B2 = cor k * B1" "C2 = cor k * C1" "D2 = cor k * D1"
using hh1[symmetric] hh2[symmetric]
by auto
let ?dsc1 = "sqrt (Re ((D1 - A1)⇧2 + 4 * (B1 * cnj B1)))" and ?dsc2 = "sqrt (Re ((D2 - A2)⇧2 + 4 * (B2 * cnj B2)))"
let ?a11 = "(A1 - D1 + cor ?dsc1) / (2 * C1)" and ?a12 = "(A2 - D2 + cor ?dsc2) / (2 * C2)"
let ?a21 = "(A1 - D1 - cor ?dsc1) / (2 * C1)" and ?a22 = "(A2 - D2 - cor ?dsc2) / (2 * C2)"
let ?r11 = "sqrt((4 - Re((-4 * ?a11/B1) * A1)) / (1 + Re (?a11*cnj ?a11)))"
let ?r12 = "sqrt((4 - Re((-4 * ?a12/B2) * A2)) / (1 + Re (?a12*cnj ?a12)))"
let ?r21 = "sqrt((4 - Re((-4 * ?a21/B1) * A1)) / (1 + Re (?a21*cnj ?a21)))"
let ?r22 = "sqrt((4 - Re((-4 * ?a22/B2) * A2)) / (1 + Re (?a22*cnj ?a22)))"
have "Re ((D2 - A2)⇧2 + 4 * (B2 * cnj B2)) = k⇧2 * Re ((D1 - A1)⇧2 + 4 * (B1 * cnj B1))"
using *
by (simp add: power2_eq_square field_simps)
hence "?dsc2 = k * ?dsc1"
using ‹k > 0›
by (simp add: real_sqrt_mult)
hence "A2 - D2 + cor ?dsc2 = cor k * (A1 - D1 + cor ?dsc1)" "A2 - D2 - cor ?dsc2 = cor k * (A1 - D1 - cor ?dsc1)" "2*C2 = cor k * (2*C1)"
using *
by (auto simp add: field_simps)
hence "?a12 = ?a11" "?a22 = ?a21"
using ‹k > 0›
by simp_all
moreover
have "Re((-4 * ?a12/B2) * A2) = Re((-4 * ?a11/B1) * A1)"
using *
by (subst ‹?a12 = ?a11›) (simp, simp add: field_simps)
have "?r12 = ?r11"
by (subst ‹Re((-4 * ?a12/B2) * A2) = Re((-4 * ?a11/B1) * A1)›, (subst ‹?a12 = ?a11›)+) simp
moreover
have "Re((-4 * ?a22/B2) * A2) = Re((-4 * ?a21/B1) * A1)"
using *
by (subst ‹?a22 = ?a21›) (simp, simp add: field_simps)
have "?r22 = ?r21"
by (subst ‹Re((-4 * ?a22/B2) * A2) = Re((-4 * ?a21/B1) * A1)›, (subst ‹?a22 = ?a21›)+) simp
moreover
have "chordal_circles_cmat H1 = ((?a11, ?r11), (?a21, ?r21))"
using hh1[symmetric]
unfolding chordal_circles_cmat_def Let_def
by (simp del: times_complex.sel)
moreover
have "chordal_circles_cmat H2 = ((?a12, ?r12), (?a22, ?r22))"
using hh2[symmetric]
unfolding chordal_circles_cmat_def Let_def
by (simp del: times_complex.sel)
ultimately
show "chordal_circles_cmat H1 = chordal_circles_cmat H2"
by metis
qed
lemma chordal_circle_radius_positive:
assumes "hermitean (A, B, C, D)" and "Re (mat_det (A, B, C, D)) ≤ 0" and "B ≠ 0" and
"dsc = sqrt(Re ((D-A)⇧2 + 4 * (B*cnj B)))" and
"a1 = (A - D + cor dsc) / (2 * C)" and "a2 = (A - D - cor dsc) / (2 * C)"
shows "Re (A*a1/B) ≥ -1 ∧ Re (A*a2/B) ≥ -1"
proof-
from assms have "is_real A" "is_real D" "C = cnj B"
using hermitean_elems
by auto
have *: "A*a1/B = ((A - D + cor dsc) / (2 * (B * cnj B))) * A"
using ‹B ≠ 0› ‹C = cnj B› ‹a1 = (A - D + cor dsc) / (2 * C)›
by (simp add: field_simps) algebra
have **: "A*a2/B = ((A - D - cor dsc) / (2 * (B * cnj B))) * A"
using ‹B ≠ 0› ‹C = cnj B› ‹a2 = (A - D - cor dsc) / (2 * C)›
by (simp add: field_simps) algebra
have "dsc ≥ 0"
proof-
have "0 ≤ Re ((D - A)⇧2) + 4 * Re ((cor (cmod B))⇧2)"
using ‹is_real A› ‹is_real D› by simp
thus ?thesis
using ‹dsc = sqrt(Re ((D-A)⇧2 + 4*(B*cnj B)))›
by (subst (asm) complex_mult_cnj_cmod) simp
qed
hence "Re (A - D - cor dsc) ≤ Re (A - D + cor dsc)"
by simp
moreover
have "Re (2 * (B * cnj B)) > 0"
using ‹B ≠ 0›
by (subst complex_mult_cnj_cmod, simp add: power2_eq_square)
ultimately
have xxx: "Re (A - D + cor dsc) / Re (2 * (B * cnj B)) ≥ Re (A - D - cor dsc) / Re (2 * (B * cnj B))" (is "?lhs ≥ ?rhs")
by (metis divide_right_mono less_eq_real_def)
have "Re A * Re D ≤ Re (B*cnj B)"
using ‹Re (mat_det (A, B, C, D)) ≤ 0› ‹C = cnj B› ‹is_real A› ‹is_real D›
by simp
have "(Re (2 * (B * cnj B)) / Re A) / Re (2 * B * cnj B) = 1 / Re A"
using ‹Re (2 * (B * cnj B)) > 0›
apply (subst divide_divide_eq_left)
apply (subst mult.assoc)
apply (subst nonzero_divide_mult_cancel_right)
by simp_all
show ?thesis
proof (cases "Re A > 0")
case True
hence "Re (A*a1/B) ≥ Re (A*a2/B)"
using * ** ‹Re (2 * (B * cnj B)) > 0› ‹B ≠ 0› ‹is_real A› ‹is_real D› xxx
using mult_right_mono[of ?rhs ?lhs "Re A"]
apply simp
apply (subst Re_divide_real, simp, simp)
apply (subst Re_divide_real, simp, simp)
apply (subst Re_mult_real, simp)+
apply simp
done
moreover
have "Re (A*a2/B) ≥ -1"
proof-
from ‹Re A * Re D ≤ Re (B*cnj B)›
have "Re (A⇧2) ≤ Re (B*cnj B) + Re ((A - D)*A)"
using ‹Re A > 0› ‹is_real A› ‹is_real D›
by (simp add: power2_eq_square field_simps)
have "1 ≤ Re (B*cnj B) / Re (A⇧2) + Re (A - D) / Re A"
using ‹Re A > 0› ‹is_real A› ‹is_real D›
using divide_right_mono[OF ‹Re (A⇧2) ≤ Re (B*cnj B) + Re ((A - D)*A)›, of "Re (A⇧2)"]
by (simp add: power2_eq_square add_divide_distrib)
have "4 * Re(B*cnj B) ≤ 4 * (Re (B*cnj B))⇧2 / Re (A⇧2) + 2*Re (A - D) / Re A * 2 * Re(B*cnj B)"
using mult_right_mono[OF ‹1 ≤ Re (B*cnj B) / Re (A⇧2) + Re (A - D) / Re A›, of "4 * Re (B*cnj B)"]
by (simp add: distrib_right) (simp add: power2_eq_square field_simps)
moreover
have "A ≠ 0"
using ‹Re A > 0›
by auto
hence "4 * (Re (B*cnj B))⇧2 / Re (A⇧2) = Re (4 * (B*cnj B)⇧2 / A⇧2)"
using Re_divide_real[of "A⇧2" "4 * (B*cnj B)⇧2"] ‹Re A > 0› ‹is_real A›
by (auto simp add: power2_eq_square)
moreover
have "2*Re (A - D) / Re A * 2 * Re(B*cnj B) = Re (2 * (A - D) / A * 2 * B * cnj B)"
using ‹is_real A› ‹is_real D› ‹A ≠ 0›
using Re_divide_real[of "A" "(4 * A - 4 * D) * B * cnj B"]
by (simp add: field_simps)
ultimately
have "Re ((D - A)⇧2 + 4 * B*cnj B) ≤ Re((A - D)⇧2 + 4 * (B*cnj B)⇧2 / A⇧2 + 2*(A - D) / A * 2 * B*cnj B)"
by (simp add: field_simps power2_eq_square)
hence "Re ((D - A)⇧2 + 4 * B*cnj B) ≤ Re(((A - D) + 2 * B*cnj B / A)⇧2)"
using ‹A ≠ 0›
by (subst power2_sum) (simp add: power2_eq_square field_simps)
hence "dsc ≤ sqrt (Re(((A - D) + 2 * B*cnj B / A)⇧2))"
using ‹dsc = sqrt(Re ((D-A)⇧2 + 4*(B*cnj B)))›
by simp
moreover
have "Re(((A - D) + 2 * B*cnj B / A)⇧2) = (Re((A - D) + 2 * B*cnj B / A))⇧2"
using ‹is_real A› ‹is_real D› div_reals
by (simp add: power2_eq_square)
ultimately
have "dsc ≤ ¦Re (A - D + 2 * B * cnj B / A)¦"
by simp
moreover
have "Re (A - D + 2 * B * cnj B / A) ≥ 0"
proof-
have *: "Re (A⇧2 + B*cnj B) ≥ 0"
using ‹is_real A›
by (simp add: power2_eq_square)
also have "Re (A⇧2 + 2*B*cnj B - A*D) ≥ Re (A⇧2 + B*cnj B)"
using ‹Re A * Re D ≤ Re (B*cnj B)›
using ‹is_real A› ‹is_real D›
by simp
finally
have "Re (A⇧2 + 2*B*cnj B - A*D) ≥ 0"
by simp
show ?thesis
using divide_right_mono[OF ‹Re (A⇧2 + 2*B*cnj B - A*D) ≥ 0›, of "Re A"] ‹Re A > 0› ‹is_real A› ‹A ≠ 0›
by (simp add: add_divide_distrib diff_divide_distrib) (subst Re_divide_real, auto simp add: power2_eq_square field_simps)
qed
ultimately
have "dsc ≤ Re (A - D + 2 * B * cnj B / A)"
by simp
hence "- Re (2 * (B * cnj B) / A) ≤ Re ((A - D - cor dsc))"
by (simp add: field_simps)
hence *: "- (Re (2 * (B * cnj B)) / Re A) ≤ Re (A - D - cor dsc)"
using ‹is_real A› ‹A ≠ 0›
by (subst (asm) Re_divide_real, auto)
from divide_right_mono[OF this, of "Re (2 * B * cnj B)"]
have "- 1 / Re A ≤ Re (A - D - cor dsc) / Re (2 * B * cnj B)"
using ‹Re A > 0› ‹B ≠ 0› ‹A ≠ 0› ‹0 < Re (2 * (B * cnj B))›
using ‹(Re (2 * (B * cnj B)) / Re A) / Re (2 * B * cnj B) = 1 / Re A›
by simp
from mult_right_mono[OF this, of "Re A"]
show ?thesis
using ‹is_real A› ‹is_real D› ‹B ≠ 0› ‹Re A > 0› ‹A ≠ 0›
apply (subst **)
apply (subst Re_mult_real, simp)
apply (subst Re_divide_real, simp, simp)
apply (simp add: field_simps)
done
qed
ultimately
show ?thesis
by simp
next
case False
show ?thesis
proof (cases "Re A < 0")
case True
hence "Re (A*a1/B) ≤ Re (A*a2/B)"
using * ** ‹Re (2 * (B * cnj B)) > 0› ‹B ≠ 0› ‹is_real A› ‹is_real D› xxx
using mult_right_mono_neg[of ?rhs ?lhs "Re A"]
apply simp
apply (subst Re_divide_real, simp, simp)
apply (subst Re_divide_real, simp, simp)
apply (subst Re_mult_real, simp)+
apply simp
done
moreover
have "Re (A*a1/B) ≥ -1"
proof-
from ‹Re A * Re D ≤ Re (B*cnj B)›
have "Re (A⇧2) ≤ Re (B*cnj B) - Re ((D - A)*A)"
using ‹Re A < 0› ‹is_real A› ‹is_real D›
by (simp add: power2_eq_square field_simps)
hence "1 ≤ Re (B*cnj B) / Re (A⇧2) - Re (D - A) / Re A"
using ‹Re A < 0› ‹is_real A› ‹is_real D›
using divide_right_mono[OF ‹Re (A⇧2) ≤ Re (B*cnj B) - Re ((D - A)*A)›, of "Re (A⇧2)"]
by (simp add: power2_eq_square diff_divide_distrib)
have "4 * Re(B*cnj B) ≤ 4 * (Re (B*cnj B))⇧2 / Re (A⇧2) - 2*Re (D - A) / Re A * 2 * Re(B*cnj B)"
using mult_right_mono[OF ‹1 ≤ Re (B*cnj B) / Re (A⇧2) - Re (D - A) / Re A›, of "4 * Re (B*cnj B)"]
by (simp add: left_diff_distrib) (simp add: power2_eq_square field_simps)
moreover
have "A ≠ 0"
using ‹Re A < 0›
by auto
hence "4 * (Re (B*cnj B))⇧2 / Re (A⇧2) = Re (4 * (B*cnj B)⇧2 / A⇧2)"
using Re_divide_real[of "A⇧2" "4 * (B*cnj B)⇧2"] ‹Re A < 0› ‹is_real A›
by (auto simp add: power2_eq_square)
moreover
have "2*Re (D - A) / Re A * 2 * Re(B*cnj B) = Re (2 * (D - A) / A * 2 * B * cnj B)"
using ‹is_real A› ‹is_real D› ‹A ≠ 0›
using Re_divide_real[of "A" "(4 * D - 4 * A) * B * cnj B"]
by (simp add: field_simps)
ultimately
have "Re ((D - A)⇧2 + 4 * B*cnj B) ≤ Re((D - A)⇧2 + 4 * (B*cnj B)⇧2 / A⇧2 - 2*(D - A) / A * 2 * B*cnj B)"
by (simp add: field_simps power2_eq_square)
hence "Re ((D - A)⇧2 + 4 * B*cnj B) ≤ Re(((D - A) - 2 * B*cnj B / A)⇧2)"
using ‹A ≠ 0›
by (subst power2_diff) (simp add: power2_eq_square field_simps)
hence "dsc ≤ sqrt (Re(((D - A) - 2 * B*cnj B / A)⇧2))"
using ‹dsc = sqrt(Re ((D-A)⇧2 + 4*(B*cnj B)))›
by simp
moreover
have "Re(((D - A) - 2 * B*cnj B / A)⇧2) = (Re((D - A) - 2 * B*cnj B / A))⇧2"
using ‹is_real A› ‹is_real D› div_reals
by (simp add: power2_eq_square)
ultimately
have "dsc ≤ ¦Re (D - A - 2 * B * cnj B / A)¦"
by simp
moreover
have "Re (D - A - 2 * B * cnj B / A) ≥ 0"
proof-
have "Re (A⇧2 + B*cnj B) ≥ 0"
using ‹is_real A›
by (simp add: power2_eq_square)
also have "Re (A⇧2 + 2*B*cnj B - A*D) ≥ Re (A⇧2 + B*cnj B)"
using ‹Re A * Re D ≤ Re (B*cnj B)›
using ‹is_real A› ‹is_real D›
by simp
finally have "Re (A⇧2 + 2*B*cnj B - A*D) ≥ 0"
by simp
show ?thesis
using divide_right_mono_neg[OF ‹Re (A⇧2 + 2*B*cnj B - A*D) ≥ 0›, of "Re A"] ‹Re A < 0› ‹is_real A› ‹A ≠ 0›
by (simp add: add_divide_distrib diff_divide_distrib) (subst Re_divide_real, auto simp add: power2_eq_square field_simps)
qed
ultimately
have "dsc ≤ Re (D - A - 2 * B * cnj B / A)"
by simp
hence "- Re (2 * (B * cnj B) / A) ≥ Re ((A - D + cor dsc))"
by (simp add: field_simps)
hence "- (Re (2 * (B * cnj B)) / Re A) ≥ Re (A - D + cor dsc)"
using ‹is_real A› ‹A ≠ 0›
by (subst (asm) Re_divide_real, auto)
from divide_right_mono[OF this, of "Re (2 * B * cnj B)"]
have "- 1 / Re A ≥ Re (A - D + cor dsc) / Re (2 * B * cnj B)"
using ‹Re A < 0› ‹B ≠ 0› ‹A ≠ 0› ‹0 < Re (2 * (B * cnj B))›
using ‹(Re (2 * (B * cnj B)) / Re A) / Re (2 * B * cnj B) = 1 / Re A›
by simp
from mult_right_mono_neg[OF this, of "Re A"]
show ?thesis
using ‹is_real A› ‹is_real D› ‹B ≠ 0› ‹Re A < 0› ‹A ≠ 0›
apply (subst *)
apply (subst Re_mult_real, simp)
apply (subst Re_divide_real, simp, simp)
apply (simp add: field_simps)
done
qed
ultimately
show ?thesis
by simp
next
case False
hence "A = 0"
using ‹¬ Re A > 0› ‹is_real A›
using complex_eq_if_Re_eq by auto
thus ?thesis
by simp
qed
qed
qed
lemma chordal_circle_det_positive:
fixes x y :: real
assumes "x * y < 0"
shows "x / (x - y) > 0"
proof (cases "x > 0")
case True
hence "y < 0"
using ‹x * y < 0›
by (smt mult_nonneg_nonneg)
have "x - y > 0"
using ‹x > 0› ‹y < 0›
by auto
thus ?thesis
using ‹x > 0›
by (metis zero_less_divide_iff)
next
case False
hence *: "y > 0 ∧ x < 0"
using ‹x * y < 0›
using mult_nonpos_nonpos[of x y]
by (cases "x=0") force+
have "x - y < 0"
using *
by auto
thus ?thesis
using *
by (metis zero_less_divide_iff)
qed
lemma cor_sqrt_squared: "x ≥ 0 ⟹ (cor (sqrt x))⇧2 = cor x"
by (simp add: power2_eq_square)
lemma chordal_circle1:
assumes "is_real A" and "is_real D" and "Re (A * D) < 0" and "r = sqrt(Re ((4*A)/(A-D)))"
shows "mk_circline A 0 0 D = chordal_circle ∞⇩h r"
using assms
proof (transfer, transfer)
fix A D r
assume *: "is_real A" "is_real D" "Re (A * D) < 0" "r = sqrt (Re ((4*A)/(A-D)))"
hence "A ≠ 0 ∨ D ≠ 0"
by auto
hence "(A, 0, 0, D) ∈ hermitean_nonzero"
using eq_cnj_iff_real[of A] eq_cnj_iff_real[of D] *
unfolding hermitean_def
by (simp add: mat_adj_def mat_cnj_def)
moreover
have "(- (cor r)⇧2, 0, 0, 4 - (cor r)⇧2) ∈ hermitean_nonzero"
by (simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
moreover
have "A ≠ D"
using ‹Re (A * D) < 0› ‹is_real A› ‹is_real D›
by auto
have "Re ((4*A)/(A-D)) ≥ 0"
proof-
have "Re A / Re (A - D) ≥ 0"
using ‹Re (A * D) < 0› ‹is_real A› ‹is_real D›
using chordal_circle_det_positive[of "Re A" "Re D"]
by simp
thus ?thesis
using ‹is_real A› ‹is_real D› ‹A ≠ D›
by (subst Re_divide_real, auto)
qed
moreover
have "- (cor (sqrt (Re (4 * A / (A - D)))))⇧2 = cor (Re (4 / (D - A))) * A"
using ‹is_real A› ‹is_real D› ‹A ≠ D› ‹Re ((4*A)/(A-D)) ≥ 0›
by (simp add: cor_sqrt_squared field_simps)
moreover
have "4 - 4 * A / (A - D) = 4 * D / (D - A)"
using‹A ≠ D›
by (simp add: divide_simps split: if_split_asm) (simp add: minus_mult_right)
hence **: "4 - (cor (sqrt (Re (4 * A / (A - D)))))⇧2 = cor (Re (4 / (D - A))) * D"
using ‹Re ((4*A)/(A-D)) ≥ 0› ‹is_real A› ‹is_real D› ‹A ≠ D›
by (simp add: cor_sqrt_squared field_simps)
ultimately
show "circline_eq_cmat (mk_circline_cmat A 0 0 D) (chordal_circle_cvec_cmat ∞⇩v r)"
using * ‹is_real A› ‹is_real D› ‹A ≠ D› ‹r = sqrt(Re ((4*A)/(A-D)))›
by (simp, rule_tac x="Re(4/(D-A))" in exI, auto, simp_all add: **)
qed
lemma chordal_circle2:
assumes "is_real A" and "is_real D" and "Re (A * D) < 0" and "r = sqrt(Re ((4*D)/(D-A)))"
shows "mk_circline A 0 0 D = chordal_circle 0⇩h r"
using assms
proof (transfer, transfer)
fix A D r
assume *: "is_real A" "is_real D" "Re (A * D) < 0" "r = sqrt (Re ((4*D)/(D-A)))"
hence "A ≠ 0 ∨ D ≠ 0"
by auto
hence "(A, 0, 0, D) ∈ {H. hermitean H ∧ H ≠ mat_zero}"
using eq_cnj_iff_real[of A] eq_cnj_iff_real[of D] *
unfolding hermitean_def
by (simp add: mat_adj_def mat_cnj_def)
moreover
have "(4 - (cor r)⇧2, 0, 0, - (cor r)⇧2) ∈ {H. hermitean H ∧ H ≠ mat_zero}"
by (auto simp add: hermitean_def mat_adj_def mat_cnj_def power2_eq_square)
moreover
have "A ≠ D"
using ‹Re (A * D) < 0› ‹is_real A› ‹is_real D›
by auto
have "Re((4*D)/(D-A)) ≥ 0"
proof-
have "Re D / Re (D - A) ≥ 0"
using ‹Re (A * D) < 0› ‹is_real A› ‹is_real D›
using chordal_circle_det_positive[of "Re D" "Re A"]
by (simp add: field_simps)
thus ?thesis
using ‹is_real A› ‹is_real D› ‹A ≠ D› Re_divide_real by force
qed
have "4 - 4 * D / (D - A) = 4 * A / (A - D)"
by (simp add: divide_simps split: if_split_asm) (simp add: ‹A ≠ D› minus_mult_right)
hence **: "4 - (cor (sqrt (Re ((4*D)/(D-A)))))⇧2 = cor (Re (4 / (A - D))) * A"
using ‹is_real A› ‹is_real D› ‹A ≠ D› ‹Re (4 * D / (D - A)) ≥ 0›
by (simp add: cor_sqrt_squared field_simps)
moreover
have "- (cor (sqrt (Re ((4*D)/(D-A)))))⇧2 = cor (Re (4 / (A - D))) * D"
using ‹is_real A› ‹is_real D› ‹A ≠ D› ‹Re (4 * D / (D - A)) ≥ 0›
by (simp add: cor_sqrt_squared field_simps)
ultimately
show "circline_eq_cmat (mk_circline_cmat A 0 0 D) (chordal_circle_cvec_cmat 0⇩v r)"
using ‹is_real A› ‹is_real D› ‹A ≠ 0 ∨ D ≠ 0› ‹r = sqrt (Re ((4*D)/(D-A)))›
using *
by (simp, rule_tac x="Re (4/(A-D))" in exI, auto, simp_all add: **)
qed
lemma chordal_circle':
assumes "B ≠ 0" and "(A, B, C, D) ∈ hermitean_nonzero" and "Re (mat_det (A, B, C, D)) ≤ 0" and
"C * a⇧2 + (D - A) * a - B = 0" and "r = sqrt((4 - Re((-4 * a/B) * A)) / (1 + Re (a*cnj a)))"
shows "mk_circline A B C D = chordal_circle (of_complex a) r"
using assms
proof (transfer, transfer)
fix A B C D a :: complex and r :: real
let ?k = "(-4) * a / B"
assume *: "(A, B, C, D) ∈ {H. hermitean H ∧ H ≠ mat_zero}" and **: "B ≠ 0" "C * a⇧2 + (D - A) * a - B = 0" and rr: "r = sqrt ((4 - Re (?k * A)) / (1 + Re (a * cnj a)))" and det: "Re (mat_det (A, B, C, D)) ≤ 0"
have "is_real A" "is_real D" "C = cnj B"
using * hermitean_elems
by auto
from ** have a12: "let dsc = sqrt(Re ((D-A)⇧2 + 4 * (B*cnj B)))
in a = (A - D + cor dsc) / (2 * C) ∨ a = (A - D - cor dsc) / (2 * C)"
proof-
have "Re ((D-A)⇧2 + 4 * (B*cnj B)) ≥ 0"
using ‹is_real A› ‹is_real D›
by (subst complex_mult_cnj_cmod) (simp add: power2_eq_square)
hence "ccsqrt ((D - A)⇧2 - 4 * C * - B) = cor (sqrt (Re ((D - A)⇧2 + 4 * (B * cnj B))))"
using csqrt_real[of "((D - A)⇧2 + 4 * (B * cnj B))"] ‹is_real A› ‹is_real D› ‹C = cnj B›
by (auto simp add: power2_eq_square field_simps)
thus ?thesis
using complex_quadratic_equation_two_roots[of C a "D - A" "-B"]
using ‹C * a⇧2 + (D - A) * a - B = 0› ‹B ≠ 0› ‹C = cnj B›
by (simp add: Let_def)
qed
have "is_real ?k"
using a12 ‹C = cnj B› ‹is_real A› ‹is_real D›
by (auto simp add: Let_def)
have "a ≠ 0"
using **
by auto
hence "Re ?k ≠ 0"
using ‹is_real (-4*a / B)› ‹B ≠ 0›
by (metis complex.expand divide_eq_0_iff divisors_zero zero_complex.simps(1) zero_complex.simps(2) zero_neq_neg_numeral)
moreover
have "(-4) * a = cor (Re ?k) * B"
using complex_of_real_Re[OF ‹is_real (-4*a/B)›] ‹B ≠ 0›
by simp
moreover
have "is_real (a/B)"
using ‹is_real ?k› is_real_mult_real[of "-4" "a / B"]
by simp
hence "is_real (B * cnj a)"
using * ‹C = cnj B›
by (metis (no_types, lifting) Im_complex_div_eq_0 complex_cnj_divide eq_cnj_iff_real hermitean_elems(3) mem_Collect_eq mult.commute)
hence "B * cnj a = cnj B * a"
using eq_cnj_iff_real[of "B * cnj a"]
by simp
hence "-4 * cnj a = cor (Re ?k) * C"
using ‹C = cnj B›
using complex_of_real_Re[OF ‹is_real ?k›] ‹B ≠ 0›
by (simp, simp add: field_simps)
moreover
have "1 + a * cnj a ≠ 0"
by (simp add: complex_mult_cnj_cmod)
have "r⇧2 = (4 - Re (?k * A)) / (1 + Re (a * cnj a))"
proof-
have "Re (a / B * A) ≥ -1"
using a12 chordal_circle_radius_positive[of A B C D] * ‹B ≠ 0› det
by (auto simp add: Let_def field_simps)
from mult_right_mono_neg[OF this, of "-4"]
have "4 - Re (?k * A) ≥ 0"
using Re_mult_real[of "-4" "a / B * A"]
by (simp add: field_simps)
moreover
have "1 + Re (a * cnj a) > 0"
using ‹a ≠ 0› complex_mult_cnj complex_neq_0
by auto
ultimately
have "(4 - Re (?k * A)) / (1 + Re (a * cnj a)) ≥ 0"
by (metis divide_nonneg_pos)
thus ?thesis
using rr
by simp
qed
hence "r⇧2 = Re ((4 - ?k * A) / (1 + a * cnj a))"
using ‹is_real ?k› ‹is_real A› ‹1 + a * cnj a ≠ 0›
by (subst Re_divide_real, auto)
hence "(cor r)⇧2 = (4 - ?k * A) / (1 + a * cnj a)"
using ‹is_real ?k› ‹is_real A› mult_reals[of ?k A]
by (simp add: cor_squared)
hence "4 - (cor r)⇧2 * (a * cnj a + 1) = cor (Re ?k) * A"
using complex_of_real_Re[OF ‹is_real (-4*a/B)›]
using ‹1 + a * cnj a ≠ 0›
by (simp add: field_simps)
moreover
have "?k = cnj ?k"
using ‹is_real ?k›
using eq_cnj_iff_real[of "-4*a/B"]
by simp
have "?k⇧2 = cor ((cmod ?k)⇧2)"
using cor_cmod_real[OF ‹is_real ?k›]
unfolding power2_eq_square by force
hence "?k⇧2 = ?k * cnj ?k"
using complex_mult_cnj_cmod[of ?k]
by simp
hence ***: "a * cnj a = (cor ((Re ?k)⇧2) * B * C) / 16"
using complex_of_real_Re[OF ‹is_real (-4*a/B)›] ‹C = cnj B› ‹is_real (-4*a/B)› ‹B ≠ 0›
by simp
from ** have "cor ((Re ?k)⇧2) * B * C - 4 * cor (Re ?k) * (D-A) - 16 = 0"
using complex_of_real_Re[OF ‹is_real ?k›]
by (simp add: power2_eq_square, simp add: field_simps, algebra)
hence "?k * (D-A) = 4 * (cor ((Re ?k)⇧2) * B * C / 16 - 1)"
by (subst (asm) complex_of_real_Re[OF ‹is_real ?k›]) algebra
hence "?k * (D-A) = 4 * (a*cnj a - 1)"
by (subst (asm) ***[symmetric]) simp
hence "4 * a * cnj a - (cor r)⇧2 * (a * cnj a + 1) = cor (Re ?k) * D"
using ‹4 - (cor r)⇧2 * (a * cnj a + 1) = cor (Re ?k) * A›
using complex_of_real_Re[OF ‹is_real (-4*a/B)›]
by simp algebra
ultimately
show "circline_eq_cmat (mk_circline_cmat A B C D) (chordal_circle_cvec_cmat (of_complex_cvec a) r)"
using * ‹a ≠ 0›
by (simp, rule_tac x="Re (-4*a / B)" in exI, simp)
qed
end